home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / mpl17ds.zip / RBBSSUB1.BAS < prev    next >
BASIC Source File  |  1989-06-14  |  73KB  |  2,033 lines
  1. ' $LINESIZE:132
  2. ' $title: 'RBBS-SUB1.BAS CPC17-1D, Copyright 1986-89 by D. Thomas Mack'
  3. '  Copyright 1987 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB1.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: September 18, 1988
  7. '  Subsequent Releases.: OCT 30 1988
  8. '  Copyright ..........: 1986, 1987, 1988
  9. '  Purpose.............:
  10. '     Subprorams that require error trapping are incorporated
  11. '     within RBBSSUB1.BAS as separately callable subroutines
  12. '     in order to free up as much code as possible within
  13. '     the 64K code segment used by RBBS-PC.BAS.
  14. '  Parameters..........: Most parameters are passed via a COMMON statement.
  15. '
  16. ' Subroutine  Line               Function of Subroutine
  17. '   Name     Number
  18. '  CHANGEDIR  20103   Change subdirectory
  19. '  CHECKINT   58360   Check input is valid integer
  20. '  FINDFREE   52000   Find amount of space on the upload disk drive
  21. '  FINDIT     20221   Find if a file exists on a device
  22. '  FINDUSER   12610   Find a user in the USERS file
  23. '  FLUSHCOM   20311   Read all characters in the communications port
  24. '  GETCOM      1420   Read a character from the communications port
  25. '  GETPASWD   58280   Read RBBS-PC's "PASSWORD" file
  26. '  GETWRK     58330   Read record from file number 2
  27. '  KILLWORK   58260   Delete a RBBS-PC "WORK" file
  28. '  NETBIOS    29900   Lock/Unlock NETBIOS semaphore files
  29. '  OPENCOM      200   Open communications port (number 3)
  30. '  OPENFMS    58190   Open the upload management system directory
  31. '  OPENOUTW   28220   Open RBBS-PC's "WORK" file (number 2) for output
  32. '  OPENRSEQ    1479   Open a sequential file (number 2) for random I/O
  33. '  OPENUSER    9400   Open the USER file (number 5)
  34. '  OPENWORK   58000   Open RBBS-PC's work file (number 2)
  35. '  OPENWRKA   58340   Open RBBS-PC's "WORK" file (number 2) for append
  36. '  PRINTIT    13674   Print line on the local PC running RBBS-PC printer
  37. '  PRINTWRK   58320   Print string to file #2 w/o CR/LF
  38. '  PRNTWRKA   58350   Print string to file #2 with CR/LF
  39. '  PUTCOM     59650   Write to the communications port
  40. '  PUTWORK    59660   Write to work file randomly
  41. '  READANY    58310   Read file number 2 into A$
  42. '  READDEF      117   Read configuration file
  43. '  READDIR    58290   Read entire lines
  44. '  READPARMS  58300   Read certain number of parameters from file 2
  45. '  SETCALL      108   Find where next callers record is
  46. '  UPDATEC    43050   Update the caller's file with elasped session time
  47. '  UPDTCALR   13665   Update to the caller's file
  48. '
  49. '  $INCLUDE: 'RBBS-VAR.BAS'
  50. '
  51. ' $SUBTITLE: 'SETCALL - subroutine to find last callers rec'
  52. ' $PAGE
  53. '
  54. '  SUBROUTINE NAME    -- SETCALL
  55. '
  56. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  57. '
  58. '  OUTPUT PARAMETERS  --  CALLERS.FILE.INDEX!
  59. '
  60. '  SUBROUTINE PURPOSE --  TO FIND WHERE TO LEAVE OFF ON CALLERS FILE
  61. '
  62. 108 SUB SETCALL STATIC
  63.     ON ERROR GOTO 65000
  64.     IF PREV.CALLERS$ = CALLERS.FILE$ OR CALLERS.FILE.PREFIX$ = "" THEN _ 'KG102505
  65.        EXIT SUB
  66.     PREV.CALLERS$ = CALLERS.FILE$
  67.     CALLERS.FILE.INDEX! = 1
  68.     CLOSE 2
  69.     CLOSE 4
  70.     IF SHARE.IT THEN _
  71.        OPEN CALLERS.FILE$ FOR RANDOM SHARED AS #4 LEN=64 _           ' KG102505
  72.     ELSE OPEN "R",4,CALLERS.FILE$,64
  73.     FIELD 4,64 AS CALLERS.RECORD$
  74.     IF LOF(4) > 0 THEN _                                             ' KG102505
  75.        CALLERS.FILE.INDEX! = LOF(4) / 64
  76.     IF CALLERS.FILE.INDEX! < 1 THEN _
  77.        CALLERS.FILE.INDEX! = 0
  78.     B$ = STRING$(13,0)
  79. 110 GET 4,CALLERS.FILE.INDEX!
  80.     IF EC > 0 THEN _
  81.        EC = 0 : _
  82.        CALLERS.FILE.INDEX! = 0 : _
  83.        EXIT SUB
  84.     IF LEFT$(CALLERS.RECORD$,13) = B$ THEN _
  85.        CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! - 1 : _
  86.        GOTO 110
  87.     END SUB
  88. '
  89. ' $SUBTITLE: 'READDEF - subroutine to read RBBS-PC.DEF file'
  90. ' $PAGE
  91. '
  92. '  SUBROUTINE NAME    -- READDEF
  93. '
  94. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  95. '                         CONFIG.FILENAME$            NAME OF RBBS-PC.DEF FILE
  96. '                         SUBROUTINE.PARAMETER = -62  ONLY READ THE .DEF FILE
  97. '
  98. '  OUTPUT PARAMETERS  --  ALL THE RBBS-PC.DEF PARAMETERS
  99. '
  100. '  SUBROUTINE PURPOSE --  TO READ THE PARAMETERS FROM THE RBBS-PC.DEF FILE
  101.      SUB READDEF (CONFIG.FILE$) STATIC
  102.      ON ERROR GOTO 65000
  103. '
  104. ' **** OPEN AND READ RBBS-PC CONFIGURATION DEFINITIONS ****
  105. '
  106. 117 IF SUBROUTINE.PARAMETER <> -62 THEN _
  107.        IF PREV.READ$ = CONFIG.FILE$ THEN _
  108.           EXIT SUB _
  109.        ELSE PREV.READ$ = CONFIG.FILE$
  110.     CLOSE 2
  111.     BULLETIN.SAVE$ = BULLETIN.MENU$
  112.     CALL OPENWORK (CONFIG.FILE$)                                     ' LP102201
  113.     CURRENT.DEF$ = CONFIG.FILE$
  114.     INPUT #2,DF$, _
  115.              DOWNLOAD.DRIVES$, _
  116.              SYSOP.PASSWORD.1$, _
  117.              SYSOP.PASSWORD.2$, _
  118.              SYSOP.FIRST.NAME$, _
  119.              SYSOP.LAST.NAME$, _
  120.              REQUIRED.RINGS, _
  121.              START.OFFICE.HOURS, _
  122.              END.OFFICE.HOURS, _
  123.              MINUTES.PER.SESSION!, _
  124.              DF, _
  125.              DF, _
  126.              UPLOAD.DIRECTORY$, _
  127.              EXPERT.USER, _
  128.              ACTIVE.BULLETINS, _
  129.              PROMPT.BELL, _
  130.              DF, _
  131.              MENUS.CAN.PAUSE, _
  132.              MENU$(1), _
  133.              MENU$(2), _
  134.              MENU$(3), _
  135.              MENU$(4), _
  136.              MENU$(5), _
  137.              MENU$(6), _
  138.              CONFERENCE.MENU$, _
  139.              DF, _
  140.              WELCOME.INTERRUPTABLE, _
  141.              REMIND.FILE.TRANSFERS, _
  142.              PAGE.LENGTH, _
  143.              MAX.MESSAGE.LINES.DEF, _
  144.              DOORS.AVAILABLE, _
  145.              DF$, _                                                  ' KG120501
  146.              MAIN.MESSAGE.FILE$, _                                   ' KG120501
  147.              MAIN.MESSAGE.BACKUP$                                    ' KG120501
  148.     INPUT #2, X$, _
  149.               COMMENTS.FILE$, _
  150.               MAIN.USER.FILE$, _
  151.               WELCOME.FILE$, _
  152.               NEWUSER.FILE$, _
  153.               MAIN.DIRECTORY.EXTENTION$
  154.     CALL BRKFNAME (X$,Y$,DF$,Z$,FALSE)                               ' KG102705
  155.     IF DF$ <> "" THEN _                                              ' KG102705
  156.        CALLERS.FILE$ = X$
  157.     IF CONFERENCE.MODE THEN _
  158.        INPUT #2, DF$ _
  159.     ELSE INPUT #2, COM.PORT$
  160.     INPUT #2, BULLETINS.OPTIONAL, _
  161.               MODEM.INIT.COMMAND$, _
  162.               RTS$, _
  163.               DF, _
  164.               FG, _
  165.               BG, _
  166.               BORDER
  167.     IF CONFERENCE.MODE THEN _
  168.        INPUT #2, DF$, _
  169.                  DF$ _
  170.     ELSE INPUT #2, RBBS.BAT$ , _
  171.                    RCTTY.BAT$
  172.     INPUT #2,OMIT.MAIN.DIRECTORY$, _
  173.              FIRST.NAME.PROMPT$, _
  174.              HELP$(3), _
  175.              HELP$(4), _
  176.              HELP$(7), _
  177.              HELP$(9), _
  178.              BULLETIN.MENU$, _
  179.              BULLETIN.PREFIX$, _
  180.              DF$, _
  181.              MESSAGE.REMINDER, _
  182.              REQUIRE.NON.ASCII, _
  183.              ASK.EXTENDED.DESC, _
  184.              MAXIMUM.NUMBER.OF.NODES, _
  185.              NETWORK.TYPE, _
  186.              RECYCLE.TO.DOS, _
  187.              DF, _
  188.              DF, _
  189.              TRASHCAN.FILE$
  190.     INPUT #2,MINIMUM.LOGON.SECURITY, _
  191.              DEFAULT.SECURITY.LEVEL, _
  192.              SYSOP.SECURITY.LEVEL, _
  193.              FILESEC.FILE$, _
  194.              SYSOP.MENU.SECURITY.LEVEL, _
  195.              CONFMAIL.LIST$, _
  196.              MAXIMUM.VIOLATIONS, _
  197.              OPT.SEC(50), _   ' SECURITY FOR SYSOP COMMANDS 1
  198.              OPT.SEC(51), _
  199.              OPT.SEC(52), _
  200.              OPT.SEC(53), _
  201.              OPT.SEC(54), _
  202.              OPT.SEC(55), _
  203.              OPT.SEC(56), _   ' SYSOP 7
  204.              PASSWORDS.FILE$, _
  205.              MAXIMUM.PASSWORD.CHANGES, _
  206.              MINIMUM.SECURITY.FOR.TEMP.PASSWORD, _
  207.              OVERWRITE.SECURITY.LEVEL, _
  208.              DOORS.TERMINAL.TYPE, _
  209.              MAX.PER.DAY
  210.     INPUT #2,OPT.SEC(1), _   ' SECURITY FOR MAIN MENU COMMANDS 1
  211.              OPT.SEC(2), _
  212.              OPT.SEC(3), _
  213.              OPT.SEC(4), _
  214.              OPT.SEC(5), _
  215.              OPT.SEC(6), _
  216.              OPT.SEC(7), _
  217.              OPT.SEC(8), _
  218.              OPT.SEC(9), _
  219.              OPT.SEC(10), _
  220.              OPT.SEC(11), _
  221.              OPT.SEC(12), _
  222.              OPT.SEC(13), _
  223.              OPT.SEC(14), _
  224.              OPT.SEC(15), _
  225.              OPT.SEC(16), _
  226.              OPT.SEC(17), _
  227.              OPT.SEC(18), _   ' MAIN COMMAND 18
  228.              MIN.NEWCALLER.BAUD, _
  229.              WAIT.BEFORE.DISCONNECT
  230.     INPUT #2,OPT.SEC(19), _      ' Security for FILE COMMANDS 1
  231.              OPT.SEC(20), _
  232.              OPT.SEC(21), _
  233.              OPT.SEC(22), _
  234.              OPT.SEC(23), _
  235.              OPT.SEC(24), _
  236.              OPT.SEC(25), _
  237.              OPT.SEC(26), _      ' FILE COMMAND 8
  238.              OPT.SEC(27), _      ' SECURITY FOR UTILITY COMMANDS 1
  239.              OPT.SEC(28), _
  240.              OPT.SEC(29), _
  241.              OPT.SEC(30), _
  242.              OPT.SEC(31), _
  243.              OPT.SEC(32), _
  244.              OPT.SEC(33), _
  245.              OPT.SEC(34), _
  246.              OPT.SEC(35), _
  247.              OPT.SEC(36), _
  248.              OPT.SEC(37), _
  249.              OPT.SEC(38), _   ' UTIL COMMAND 12
  250.              OPT.SEC(46), _   ' SECURITY FOR GLOBAL COMMANDS 1
  251.              OPT.SEC(47), _
  252.              OPT.SEC(48), _
  253.              OPT.SEC(49), _   ' GLOBAL 4
  254.              UPLOAD.TIME.FACTOR!, _
  255.              COMPUTER.TYPE, _
  256.              REMIND.PROFILE, _
  257.              RBBS.NAME$, _
  258.              COMMANDS.BETWEEN.RINGS, _
  259.              MNP.SUPPORT, _
  260.              PAGING.PRINTER.SUPPORT$, _
  261.              MODEM.INIT.BAUD$
  262.              IF EC > 0 THEN _
  263.                 EXIT SUB
  264. 118 INPUT #2, TURN.PRINTER.OFF,_    ' Turn printer off each recycle
  265.               DIRECTORY.PATH$, _    ' Where dir files are stored
  266.               MIN.SEC.TO.VIEW, _
  267.               LIMIT.SEARCH.TO.FMS, _
  268.               DEFAULT.CATEGORY.CODE$, _
  269.               DIR.CATEGORY.FILE$, _
  270.               NEW.FILES.CHECK, _
  271.               MAX.DESC.LEN, _
  272.               SHOW.SECTION, _
  273.               COMMANDS.IN.PROMPT, _
  274.               NEWUSER.SETS.DEFAULTS, _
  275.               HELP.PATH$, _
  276.               HELP.EXTENSION$, _
  277.               MAIN.COMMANDS$, _
  278.               FILE.COMMANDS$, _
  279.               UTIL.COMMANDS$, _
  280.               GLOBAL.COMMANDS$, _
  281.               SYSOP.COMMANDS$
  282.     INPUT #2, RECYCLE.WAIT, _
  283.               OPT.SEC(39), _       ' SECURITY FOR LIBRARY COMMANDS 1
  284.               OPT.SEC(40), _
  285.               OPT.SEC(41), _
  286.               OPT.SEC(42), _
  287.               OPT.SEC(43), _
  288.               OPT.SEC(44), _
  289.               OPT.SEC(45), _       ' LIBRARY COMMANDS 7
  290.               LIBRARY.DRIVE$, _
  291.               LIBRARY.DIRECTORY.PATH$, _
  292.               LIBRARY.DIRECTORY.EXTENTION$, _
  293.               LIBRARY.WORK.DISK.PATH$, _
  294.               LIBRARY.MAX.DISK, _
  295.               LIBRARY.MAX.DIRECTORY, _
  296.               LIBRARY.MAX.SUBDIR, _
  297.               LIBRARY.SUBDIR.PREFIX$, _
  298.               LIBRARY.ARCHIVE.PATH$, _
  299.               LIBRARY.ARCHIVE.PROGRAM$, _
  300.               LIBRARY.COMMANDS$
  301. '
  302. ' *****  ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS   ****
  303. ' *****     GET DOS SUB-DIRECTORY RBBS-PC OPTIONS              ****
  304. '
  305.     INPUT #2, UPLOAD.PATH$, _              ' Where upl dir goes
  306.               MAIN.FMS.DIRECTORY$, _       ' Shared dir in FMS
  307.               ANS.MENU$, _
  308.               REQUIRED.QUESTIONNAIRE$,_
  309.               REMEMBER.NEW.USERS,_
  310.               SURVIVE.NOUSER.ROOM,_
  311.               PROMPT.HASH$,_
  312.               START.HASH,_
  313.               LEN.HASH,_
  314.               PROMPT.INDIV$,_
  315.               START.INDIV,_
  316.               LEN.INDIV
  317.     INPUT #2, BYPASS.MSGS, _
  318.               MUSIC, _
  319.               RESTRICT.BY.DATE, _
  320.               DAYS.TO.WARN, _
  321.               DAYS.IN.REGISTRATION.PERIOD, _
  322.               CALLBACK.VERIFICATION, _
  323.               RESTRICT.VALID.CMDS, _
  324.               NEW.USER.DEFAULT.MODE, _
  325.               NEW.USER.LINE.FEEDS, _
  326.               ARKVIEW.PATH$, _
  327.               NEW.USER.BELL, _
  328.               NEW.USER.CASE, _
  329.               NEW.USER.MARGINS, _
  330.               WRAP.CALLERS.FILE$, _
  331.               REDIRECT.IO.METHOD, _
  332.               GO.TO.SHELL, _
  333.               HALT.ON.ERROR, _
  334.               NEW.PUBLIC.MSGS.SECURITY, _
  335.               NEW.PRIVATE.MSGS.SECURITY, _
  336.               SECURITY.NEEDED.TO.CHANGE.MSGS, _
  337.               SL.CATEGORIZE.UPLOADS, _
  338.               BAUDOT, _
  339.               TIME.TO.DROP.TO.DOS, _
  340.               EXPIRED.SECURITY, _
  341.               DTR.DROP.DELAY, _
  342.               ASK.IDENTITY, _
  343.               USE.EXTERNAL.XMODEM, _
  344.               BUFFER.SIZE, _
  345.               MLCOM, _
  346.               SHOOT.YOURSELF, _
  347.               F7.MESSAGE$, _
  348.               NEW.USER.DEFAULT.PROTOCOL$, _
  349.               NEW.USER.GRAPHICS$, _
  350.               NET.MAIL$, _
  351.               MASTER.DIRECTORY.NAME$, _
  352.               PROTO.DEF$, _
  353.               UPCAT.HELP$, _
  354.               ALWAYS.STREW.TO$, _
  355.               LAST.NAME.PROMPT$
  356.     INPUT #2, PERSONAL.DRVPATH$, _
  357.               PERSONAL.DIR$, _
  358.               PERSONAL.BEGIN, _
  359.               PERSONAL.LEN, _
  360.               PERSONAL.PROTOCOL$, _
  361.               PERSONAL.CONCAT , _
  362.               PRIVATE.READ.SEC, _
  363.               PUBLIC.READ.SEC, _
  364.               SEC.CHANGE.MSG, _
  365.               KEEP.INIT.BAUD, _
  366.               MAIN.PUI$                                              ' KG110504
  367.     IF CONFERENCE.MODE THEN _                                        ' KG110504
  368.        INPUT #2, DF$,DF$,DF$ _                                       ' KG110504
  369.     ELSE INPUT #2, DEFAULT.ECHOER$, _                                ' KG110504
  370.                    HOST.ECHO.ON$, _                                  ' KG110504
  371.                    HOST.ECHO.OFF$                                    ' KG110504
  372.    INPUT #2,  SWITCH.BACK, _                  Pe11/07/88
  373.               DEFAULT.LINE.ACK$, _
  374.               ALTDIR.EXTENSION$, _
  375.               DIRECTORY.PREFIX$
  376.     IF CONFERENCE.MODE THEN _
  377.        INPUT #2, DF, _
  378.                  DF, _
  379.                  DF _
  380.     ELSE INPUT #2, DF,_
  381.                    MODEM.INIT.WAIT.TIME, _
  382.                    MODEM.COMMAND.DELAY.TIME
  383.     INPUT #2, TURBO.RBBS, _
  384.               SUBDIR.COUNT, _
  385.               DF, _
  386.               UPLOAD.TO.SUBDIR, _
  387.               DF, _
  388.               UPLOAD.SUBDIR$, _
  389.               MIN.OLDCALLER.BAUD, _
  390.               USE.EXTERNAL.YMODEM, _
  391.               DISKFULL.GO.OFFLINE, _
  392.               EXTENDED.LOGGING
  393.      IF CONFERENCE.MODE THEN _
  394.         INPUT #2, DF$, _
  395.                   DF$, _
  396.                   DF$, _
  397.                   DF$ _
  398.      ELSE INPUT #2, MODEM.RESET.COMMAND$, _
  399.                     MODEM.COUNT.RINGS.COMMAND$, _
  400.                     MODEM.ANSWER.COMMAND$, _
  401.                     MODEM.GO.OFFHOOK.COMMAND$
  402.      INPUT #2,DISK.FOR.DOS$, _
  403.               DUMB.MODEM, _
  404.               COMMENTS.AS.MESSAGES
  405.      IF CONFERENCE.MODE THEN _
  406.         INPUT #2, DF, _
  407.                   DF, _
  408.                   DF, _
  409.                   DF, _
  410.                   DF, _
  411.                   DF _
  412.      ELSE INPUT #2, LSB,_
  413.                     MSB,_
  414.                     LINE.CONTROL.REGISTER,_
  415.                     MODEM.CONTROL.REGISTER,_
  416.                     LINE.STATUS.REGISTER,_
  417.                     MODEM.STATUS.REGISTER
  418.      INPUT #2,KEEP.TIME.CREDITS, _
  419.               XON.XOFF, _
  420.               ALLOW.CALLER.TURBO, _
  421.               USE.DEVICE.DRIVER$, _
  422.               PRELOG$, _
  423.               NEW.USER.QUESTIONNAIRE$, _
  424.               EPILOG$, _
  425.               REGISTRATION.PROGRAM$, _
  426.               QUES.PATH$, _
  427.               USER.LOCATION$, _
  428.               DF$, _
  429.               DF$, _
  430.               DF$, _
  431.               ENFORCE.UPLOAD.DOWNLOAD.RATIOS, _
  432.               SIZE.OF.STACK, _
  433.               SECURITY.EXEMPT.FROM.EPILOG, _
  434.               USE.BASIC.WRITES, _
  435.               DOSANSI, _
  436.               ESCAPE.INSECURE, _
  437.               USE.DIR.ORDER, _
  438.               ADD.DIR.SECURITY, _
  439.               MAX.EXTENDED.LINES, _
  440.               ORIG.COMMANDS$
  441.      INPUT #2,LOGON.MAIL.LEVEL$, _
  442.               MACRO.DRVPATH$, _
  443.               MACRO.EXTENSION$, _
  444.               EMPHASIZE.ON.DEF$, _
  445.               EMPHASIZE.OFF.DEF$, _
  446.               FG.1.DEF$, _
  447.               FG.2.DEF$, _
  448.               FG.3.DEF$, _
  449.               FG.4.DEF$, _
  450.               SECVIO.HLP$                                            ' KG101402
  451.      IF CONFERENCE.MODE THEN _                                       ' KG101402
  452.         INPUT #2,DF _                                                ' KG101402
  453.      ELSE INPUT #2,FOSSIL                                            ' KG101402
  454.      INPUT #2,MAX.CARRIER.WAIT, _                                    ' KG101402
  455.               DF, _
  456.               SMART.TEXT, _
  457.               TIME.LOCK, _
  458.               WRITE.BUF.DEF, _
  459.               DF, _
  460.               DF, _
  461.               DF, _
  462.               AUTOPAGE.DEF$
  463.      IF EC > 0 THEN _
  464.         EXIT SUB
  465.      CONFIG.FILENAME$ = CONFIG.FILE$                                 ' KG121501
  466.      CALL EDITDEF
  467.      END SUB
  468. ' $SUBTITLE: 'OPENCOM - subroutine to open the communications port'
  469. ' $PAGE
  470. '
  471. '  SUBROUTINE NAME    -- OPENCOM
  472. '
  473. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  474. '                       BAUD.RATE$                 BAUD TO OPEN MODEM
  475. '                       PARITY$                    PARITY TO OPEN MODEM
  476. '
  477. '  OUTPUT PARAMETERS -- BAUD.TEST                  BAUD RATE TO SET RS232 AT
  478. '
  479. '  SUBROUTINE PURPOSE -- TO OPEN THE COMMUNICATIONS PORT.
  480. '
  481.       SUB OPENCOM(BAUD.RATE$,PARITY$) STATIC
  482.       ON ERROR GOTO 65000
  483. 200 IF FOSSIL THEN _
  484.        IF RTS$ = "YES" THEN _
  485.           FLOW.CONTROL = TRUE : _
  486.           FLOW% = &H00F2 : _
  487.           CALL FOSFLOWCTL(COMPORT%,FLOW%)
  488.     IF INSTR(PARITY$,"N") THEN _
  489.        PARITY% = 2 : _                                     ' NO PARITY
  490.        DATABITS% = 3 : _                                   ' 8 DATA BITS
  491.        STOPBITS% = 0 _                                     ' 1 STOP BIT
  492.     ELSE PARITY% = 3 : _                                   ' EVEN PARITY
  493.          DATABITS% = 2 : _                                 ' 7 DATA BITS
  494.          STOPBITS% = 0                                     ' 1 STOP BIT
  495.     IF FOSSIL THEN _
  496.        COMSPEED% = VAL(BAUD.RATE$) : _
  497.        CALL FOSSPEED(COMPORT%,COMSPEED%,PARITY%,DATABITS%,STOPBITS%) : _
  498.        EXIT SUB
  499.     CLOSE 3
  500.     IF RTS$ = "YES" THEN _
  501.        FLOW.CONTROL = TRUE : _
  502.        X$ = ",CS26600,CD,DS" _
  503.     ELSE X$ = ",RS,CD,DS"
  504.     OPEN COM.PORT$ + ":" + BAUD.RATE$ + PARITY$ + X$ AS #3
  505. '
  506. ' *****************************************************************************
  507. ' *  RAISE THE RTS SIGNAL IF THE MODEM USES RTS FOR MODEM FLOW CONTROL (ONCE  *
  508. ' *  IT IS RAISED, IT WILL STAY UP UNTIL THE REGISTER IS CLEARED OUT).        *
  509. ' *****************************************************************************
  510. '
  511.     END SUB
  512. ' $SUBTITLE: 'GETCOM -- subroutine reads a char. from  comm. port'
  513. ' $PAGE
  514. '
  515. '  SUBROUTINE NAME    -- GETCOM
  516. '
  517. '  INPUT PARAMETERS   --   PARAMETER     MEANING
  518. '                          STNG$       STRING TO READ A CHARACTER INTO FROM
  519. '                                      THE COMMUNICATIONS PORT (FILE #3)
  520. '
  521. '  OUTPUT PARAMETERS  --   STNG$
  522. '
  523. '  SUBROUTINE PURPOSE -- READS A CHARACTER FROM FROM THE COMMUNICATIONS PORT.
  524. '
  525.       SUB GETCOM (STRNG$) STATIC
  526.       ON ERROR GOTO 65000
  527. 1420 IF FOSSIL THEN _
  528.         CALL FOSRXCHAR(COMPORT%,CHAR%) : _
  529.         STRNG$ = CHR$(CHAR%) _
  530. ELSE  STRNG$ = INPUT$(1,3)
  531. 1421 IF EC = 57 THEN _
  532.         LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  533.         EC = 0 : _
  534.         GOTO 1420
  535.      END SUB
  536. ' $SUBTITLE: 'OPENRSEQ  - subroutine open sequential file randomly'
  537. ' $PAGE
  538. '
  539. '  SUBROUTINE NAME    -- OPENRSEQ
  540. '
  541. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  542. '                        FILNAME$      NAME OF SEQUENTIAL FILE TO OPEN AS #2
  543. '
  544. '  OUTPUT PARAMETERS  -- NUM.RECS      NUMBER OF 128-BYTE RECORDS IN THE FILE
  545. '                        LEN.LAST.REC  NUMBER OF BYTES IN THE LAST RECORD (IT
  546. '                                      MAY BE LESS THAN OR EQUAL TO 128).
  547. '
  548. '  SUBROUTINE PURPOSE -- SUBROUTINE TO OPEN A SEQUENTIAL FILE AS FILE # 2 AND
  549. '                        READ IT RANDOMLY.
  550. '
  551.      SUB OPENRSEQ (FILNAME$,NUM.RECS,LEN.LAST.REC,REC.LEN) STATIC
  552. 1479 ON ERROR GOTO 65000
  553.      CLOSE 2
  554. 1480 EC = 0
  555. 1481 IF SHARE.IT THEN _
  556.         OPEN FILNAME$ FOR RANDOM SHARED AS #2 LEN=REC.LEN _
  557.      ELSE OPEN "R",2,FILNAME$,REC.LEN
  558.      IF EC = 52 THEN _
  559.         GOTO 1480
  560.      FIELD #2, REC.LEN AS DOWNLOAD.RECORD$
  561.      I# = LOF(2)
  562.      NUM.RECS = FIX(I#/REC.LEN)
  563.      LEN.LAST.REC = I# - CDBL(NUM.RECS) * REC.LEN
  564.      IF LEN.LAST.REC > 0 THEN _
  565.         NUM.RECS = NUM.RECS + 1 _
  566.      ELSE LEN.LAST.REC = REC.LEN
  567.   END SUB
  568. ' $SUBTITLE: 'OPENUSER - subroutine to open the users file as #5'
  569. ' $PAGE
  570. '
  571. '  SUBROUTINE NAME    -- OPENUSER
  572. '
  573. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  574. '                        SHARE.IT
  575. '
  576. '  OUTPUT PARAMETERS  -- ACTIVE.USER.FILE$
  577. '                        CITY.STATE$
  578. '                        ELAPSED.TIME$
  579. '                        LAST.DATE.TIME.ON$
  580. '                        LAST.REC            # OF LAST RECORD IN USERS FILE
  581. '                        LIST.NEW.DATE$
  582. '                        MACHINE.TYPE$
  583. '                        PASSWORD$
  584. '                        SECURITY.LEVEL$
  585. '                        USER.DOWNLOADS$
  586. '                        USER.NAME$
  587. '                        USER.OPTIONS$
  588. '                        USER.RECORD$
  589. '                        USER.UPLOADS$
  590. '
  591. '  SUBROUTINE PURPOSE -- OPEN THE USER FILE AS FILE # 5
  592. '
  593.       SUB OPENUSER (LAST.REC) STATIC
  594.       ON ERROR GOTO 65000
  595. '
  596. ' ****  OPEN AND DEFINE USER FILE RECORD VARIABLES  ****                              *
  597. '
  598. 9400 CLOSE 5
  599.      IF SHARE.IT THEN _
  600.         OPEN ACTIVE.USER.FILE$ FOR RANDOM SHARED AS #5 LEN=128 _
  601.      ELSE OPEN "R",5,ACTIVE.USER.FILE$,128
  602.      I# = LOF(5)
  603.      LAST.REC = FIX(I#/128)
  604.      FIELD 5,31 AS USER.NAME$, _
  605.              15 AS PASSWORD$, _
  606.               2 AS SECURITY.LEVEL$, _
  607.              14 AS USER.OPTIONS$,  _
  608.              24 AS CITY.STATE$, _
  609.               3 AS MACHINE.TYPE$, _
  610.               4 AS TODAY.DL$, _
  611.               4 AS TODAY.BYTES$, _
  612.               4 AS DL.BYTES$, _
  613.               4 AS UL.BYTES$, _
  614.              14 AS LAST.DATE.TIME.ON$, _
  615.               3 AS LIST.NEW.DATE$, _
  616.               2 AS USER.DOWNLOADS$, _
  617.               2 AS USER.UPLOADS$, _
  618.               2 AS ELAPSED.TIME$
  619.      FIELD 5,128 AS USER.RECORD$
  620.      END SUB
  621. ' $SUBTITLE: 'FINDUSER - subroutine to search users file for a name'
  622. ' $PAGE
  623. '
  624. '  SUBROUTINE NAME    -- FINDUSER
  625. '
  626. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  627. '                        HASH.TO.LOOK.FOR$    STRING TO SEARCH FOR IN USERS
  628. '                        INDIV.TO.LOOK.FOR$   STRING TO USE TO INDIVIDUATE
  629. '                                             USERS WITH SAME HASH
  630. '                        START.HASH.POS       WHERE HASH FIELD STARTS IN THE
  631. '                                             "USERS" FILE
  632. '                        LEN.HASH.FIELD       LENGTH OF THE HASH FIELD
  633. '                        START.INDIV.POS      WHERE THE FIELD TO DISTINGUISH
  634. '                                             AMONG USERS (I.E. WITH THE SAME
  635. '                                             NAME) STARTS IN THE "USERS" FILE
  636. '                                             (SET TO 0 IF NONE TO BE USED)
  637. '                        LEN.INDIV.FIELD      LENGTH OF FIELD TO DISTINGUISH
  638. '                                             AMONG USERS
  639. '                        MAX.POSITION         HIGHEST RECORD TO SEARCH OR USE
  640. '
  641. '  NOTE: THIS SUBROUTINE ASSUMES THE "USERS" FILE IS OPEN AS FILE 2.
  642. '
  643. '  OUTPUT PARAMETERS  -- WHETHER.FOUND        SET TO "TRUE" IF USER WAS FOUND
  644. '                                             OTHERWISE IT IS "FALSE"
  645. '                        POS.TO.USE           NUMBER OF THE "USERS" RECORD THAT
  646. '                                             BELONGS TO THE USER (IF FOUND) OR
  647. '                                             TO USE FOR THE USER (IF THE USER
  648. '                                             WASN'T FOUND)
  649. '                        POS.TO.RECLAIM       SET TO 0 IF THE RECORD NUMBER
  650. '                                             SELECTED FOR THIS USER HAS NEVER
  651. '                                             BEEN USED.
  652. '
  653. '  SUBROUTINE PURPOSE -- TO SEARCH THE "USERS" FILE AND DETERMINE THE RECORD
  654. '                        NUMBER TO USE FOR THE CALLER IN THE "USERS" FILE.
  655. '
  656.       SUB FINDUSER (HASH.TO.LOOK.FOR$,INDIV.TO.LOOK.FOR$,START.HASH.POS,_
  657.                     LEN.HASH.FIELD,START.INDIV.POS,LEN.INDIV.FIELD,_
  658.                     MAX.POSITION,WHETHER.FOUND,_
  659.                     POS.TO.USE,POS.TO.RECLAIM) STATIC
  660.       ON ERROR GOTO 65000
  661.       EC = 0
  662.       WHETHER.FOUND = 0
  663.       IF HASH.TO.LOOK.FOR$ = SPACE$(LEN(HASH.TO.LOOK.FOR$)) THEN _
  664.          EXIT SUB
  665.       EMPTY.REC$ = SPACE$(LEN.HASH.FIELD)
  666.       EMPTY.INDIV$ = SPACE$(LEN.INDIV.FIELD)
  667.       NEWUSER$ = LEFT$("NEWUSER  ",LEN.HASH.FIELD + 2)
  668.       FIELD 5, 128 AS FILLER$
  669.       X$ = HASH.TO.LOOK.FOR$ + SPACE$(LEN.HASH.FIELD - LEN(HASH.TO.LOOK.FOR$))
  670.       CALL HASHRBBS (HASH.TO.LOOK.FOR$,MAX.POSITION,POS.TO.USE,DF)
  671. 12600  Y$ = INDIV.TO.LOOK.FOR$ + SPACE$(LEN.INDIV.FIELD - LEN(INDIV.TO.LOOK.FOR$))
  672.       POS.TO.RECLAIM = 0
  673. 12610 GET 5,POS.TO.USE
  674.       IF EC > 0 THEN _
  675.          IF EC = 63 THEN _
  676.             EC = O : _
  677.             GOTO 12621 _
  678.          ELSE EC = 0 : _
  679.          GOTO 12620
  680.       HASH.VALUE$ = MID$(FILLER$,START.HASH.POS,LEN.HASH.FIELD)
  681.       IF X$ = HASH.VALUE$ THEN _
  682.          IF START.INDIV.POS < 1 THEN _
  683.            WHETHER.FOUND = TRUE : _
  684.            GOTO 12622 _
  685.          ELSE INDIV.VALUE$ = MID$(FILLER$,START.INDIV.POS,LEN.INDIV.FIELD) : _
  686.               IF Y$ = INDIV.VALUE$ OR INDIV.VALUE$ = EMPTY.INDIV$ THEN _
  687.                  WHETHER.FOUND = TRUE : _
  688.                  GOTO 12622
  689.       IF HASH.VALUE$ = EMPTY.REC$ THEN _
  690.          POS.TO.USE = POS.TO.RECLAIM - (POS.TO.RECLAIM = 0) * POS.TO.USE : _
  691.          WHETHER.FOUND = FALSE : _
  692.          GOTO 12622
  693.       IF ASC(HASH.VALUE$) = 0 OR INSTR(HASH.VALUE$,NEWUSER$) = 1 THEN _
  694.          IF POS.TO.RECLAIM = 0 THEN _
  695.             POS.TO.RECLAIM = POS.TO.USE
  696. 12620 POS.TO.USE = POS.TO.USE + DF
  697.       IF POS.TO.USE > MAX.POSITION - 1 THEN _
  698.          POS.TO.USE = POS.TO.USE - MAX.POSITION
  699.       GOTO 12610
  700. 12621 IF POS.TO.RECLAIM = 0 THEN _
  701.          POS.TO.RECLAIM = POS.TO.USE
  702.       GOTO 12620
  703. 12622 END SUB
  704. ' $SUBTITLE: 'UPDTCALR - subroutine to write to CALLERS file'
  705. ' $PAGE
  706. '
  707. '  SUBROUTINE NAME    -- UPDTCALR
  708. '
  709. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  710. '                        ERRMES$                   MESSAGE TO GO IN CALLER LOG
  711. '                        EXT.LOG              = 1  CHECK FOR EXTENDED LOGGING
  712. '                                                  BEFORE UPDATING.
  713. '                                             = 2  UPDATE CALLER LOG WITH Z$
  714. '
  715. '  OUTPUT PARAMETERS  -- CURRENT.DATE$           CURRENT DATE (MM-DD-YY)
  716. '                        TIM$                    CURRENT TIME (I.E. 1:13 PM)
  717. '                        TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  718. '
  719. '  SUBROUTINE PURPOSE -- TO UPDATE THE CALLER'S FILE AND/OR PRINT ON THE
  720. '                        LOCAL PRINTER IF IT IS ENABLED
  721. '
  722.       SUB UPDTCALR (ERRMES$,EXT.LOG) STATIC
  723.       ON ERROR GOTO 65000
  724.       IF CALLERS.FILE.PREFIX$ = "" OR (LOCAL.USER AND SYSOP) THEN _   'KG121802
  725.          EXIT SUB
  726.       X$ = "     " + ERRMES$
  727. 13663 EC = 0
  728.       FIELD 4, 64 AS CALLERS.RECORD$
  729.       IF EC > 0 THEN _
  730.          CALL QTPUT ("Caller's file:  error"+STR$(EC),1) : _
  731.          EC = 0 : _
  732.          EXIT SUB
  733.       ON EXT.LOG GOTO 13665,13670
  734. '
  735. ' ****  EXTENDED LOGGING ENTRY  ****
  736. '
  737. 13665 IF NOT EXTENDED.LOGGING THEN _
  738.          EXIT SUB
  739.       SUBROUTINE.PARAMETER = 2
  740.       CALL AMORPM
  741.       X$ = X$ + " at " + TIM$
  742. '
  743. ' ****  UPDATE CALLERS FILE WITH USER ACTIVITY  ****                                  *
  744. '
  745. 13670 LSET CALLERS.RECORD$ = X$
  746.       CALL PRINTIT (CALLERS.RECORD$)
  747.       IF LOCAL.USER AND PRINTER THEN _
  748.          EXIT SUB
  749.       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
  750. 13672 PUT 4,CALLERS.FILE.INDEX!                        'KG102502
  751.       END SUB
  752. ' $SUBTITLE: 'PRINTIT - subroutine to print on the local PC's printer'
  753. ' $PAGE
  754. '
  755. '  SUBROUTINE NAME    -- PRINTIT
  756. '
  757. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  758. '                             STRNG$             STRING TO WRITE TO THE PRINTER
  759. '
  760. '  OUTPUT PARAMETERS  -- NONE
  761. '
  762. '  SUBROUTINE PURPOSE -- TO WRITE TO THE PRINTER ATTACHED TO THE PC RUNNING
  763. '                        RBBS-PC AND TOGGLE THE PRINTER SWTICH OFF WHENEVER
  764. '                        THE PRINTER IS/BECOMES UNAVAILABLE
  765. '
  766.       SUB PRINTIT (STRNG$) STATIC
  767.       ON ERROR GOTO 65000
  768. 13674 IF PRINTER THEN _
  769.          LPRINT STRNG$
  770.       END SUB
  771. ' $SUBTITLE: 'CHANGEDIR - subroutine to change subdirectories'
  772. ' $PAGE
  773. '
  774. '  SUBROUTINE NAME    -- CHANGEDIR
  775. '
  776. '  INPUT PARAMETERS   -- PARAMETER                    MEANING
  777. '                        DIRECTORY$              NAME OF SUBDIRECTORY
  778. '
  779. '  OUTPUT PARAMETERS  -- OK                      TRUE IF CHDIR SUCCESSFUL
  780. '                        EC                      ERROR CODE
  781. '
  782. '  SUBROUTINE PURPOSE -- CHANGE SUBDIRECTORY
  783. '
  784.       SUB CHANGEDIR (DIRECTORY$) STATIC
  785.       ON ERROR GOTO 65000
  786.       EC = 0
  787.       OK = TRUE
  788. 20103 CHDIR DIRECTORY$
  789.       END SUB
  790. ' $SUBTITLE: 'FINDIT - subroutine to find if a file exists'
  791. ' $PAGE
  792. '
  793. '  SUBROUTINE NAME    -- FINDIT
  794. '
  795. '  INPUT PARAMETERS   -- PARAMETER                    MEANING
  796. '                        FILNAME$                NAME OF FILE TO FIND
  797. '
  798. '  OUTPUT PARAMETERS  -- OK                      TRUE IF FILE EXISTS
  799. '                        EC                      ERROR CODE
  800. '
  801. '  SUBROUTINE PURPOSE -- DETERMINE IF A FILE EXISTS BY RENAMING IT TO ITSELF
  802. '
  803.       SUB FINDIT (FILNAME$) STATIC
  804.       ON ERROR GOTO 65000
  805.       EC = 0
  806.       OK = FALSE
  807.       IF LEN(FILNAME$) < 1 THEN _
  808.          EXIT SUB
  809.       IF TURBO.RBBS THEN _
  810.          CALL FINDFILE (FILNAME$,OK) : _
  811.          IF OK THEN _
  812.             GOTO 20222 _
  813.          ELSE EXIT SUB
  814. 20221 CALL BADFILECHAR (FILNAME$,OK)
  815.       IF NOT OK THEN _
  816.          EXIT SUB
  817.       OK = FALSE
  818.       NAME FILNAME$ AS FILNAME$
  819.       IF EC = 53 THEN _
  820.          EXIT SUB
  821. 20222 CLOSE 2
  822. 20223 CALL OPENWORK (FILNAME$)                                       ' KG102207
  823.       IF EC = 64 OR EC = 76 THEN _
  824.          EXIT SUB
  825.       OK = TRUE
  826.       END SUB
  827. ' $SUBTITLE: 'FLUSHCOM -- subroutine reads all char. from  comm. port'
  828. ' $PAGE
  829. '
  830. '  SUBROUTINE NAME    -- FLUSHCOM
  831. '
  832. '  INPUT PARAMETERS   --   PARAMETER     MEANING
  833. '                          STNG$       STRING TO READ CHARACTERS INTO FROM
  834. '                                      THE COMMUNICATIONS PORT (FILE #3)
  835. '
  836. '  OUTPUT PARAMETERS  --   STNG$
  837. '
  838. '  SUBROUTINE PURPOSE -- READS ALL CHARACTER FROM FROM THE COMMUNICATIONS PORT.
  839. '
  840.       SUB FLUSHCOM (STRNG$) STATIC
  841.       ON ERROR GOTO 65000
  842.       IF LOCAL.USER THEN _
  843.          EXIT SUB
  844.       STRNG$ = ""
  845.       IF NOT FOSSIL THEN _
  846.          GOTO 20311
  847. 20310 CALL FOSREADAHEAD(COMPORT%,CHAR%)
  848.       IF CHAR% <> -1 THEN _
  849.         CALL FOSRXCHAR(COMPORT%,CHAR%) : _
  850.         STRNG$ = STRNG$ + CHR$(CHAR%) : _
  851.         GOTO 20310
  852.       EXIT SUB
  853. 20311 STRNG$ = INPUT$(LOC(3),3)                     ' FLUSH THE COMM BUFFER
  854. 20312 IF EC = 57 THEN _
  855.          LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  856.          EC = 0 : _
  857.          GOTO 20311
  858.       END SUB
  859. ' $SUBTITLE: 'NETBIOS - subroutine to lock/unlock using NETBIOS'
  860. ' $PAGE
  861. '
  862. '  SUBROUTINE NAME    -- NETBIOS   (WRITTEN BY DOUG AZZARITO)
  863. '
  864. '  INPUT PARAMETERS   -- IBM.LOCK.CMD       = 1-LOCK, 0-UNLOCK
  865. '                        IBM.FILE.LOCK      = 5 USERS FILE
  866. '                                           = 6 SEMAPHORE FILE
  867. '                        IBM.RECORD.LOCK    = RECORD NUMBER TO LOCK
  868. '
  869. '  OUTPUT PARAMETERS  -- NONE
  870. '
  871. '  SUBROUTINE PURPOSE -- LOCK AND UNLOCK FILES USING NETBIOS CMNDS.
  872. '                        IF LOCK FAILS, THIS ROUTINE TRIES FOREVER.
  873. '
  874.       SUB NETBIOS (IBM.LOCK.CMD,IBM.FILE.LOCK,IBM.RECORD.LOCK) STATIC
  875. 29900 ON IBM.LOCK.CMD + 1 GOTO 29920, 29910
  876.       EXIT SUB
  877. '
  878. ' *****  LOCK LOOP   *****
  879. '
  880. 29910 EC = 0
  881.       IF IBM.FILE.LOCK = 6 AND IBM.RECORD.LOCK = 3 THEN _
  882.          IBMCOUNT = IBMCOUNT + 1 : _
  883.          IF IBMCOUNT > 1 THEN _
  884.             EXIT SUB
  885.       LOCK IBM.FILE.LOCK, IBM.RECORD.LOCK TO IBM.RECORD.LOCK
  886.       IF EC <> 0 THEN _
  887.          GOTO 29910
  888.       EXIT SUB
  889. 29920 EC = 0
  890.       IF IBM.FILE.LOCK = 6 AND IBM.RECORD.LOCK = 3 THEN _
  891.          IBMCOUNT = IBMCOUNT - 1 : _
  892.          IF IBMCOUNT > 0 THEN _
  893.             EXIT SUB _
  894.          ELSE IBMCOUNT = 0
  895.       UNLOCK IBM.FILE.LOCK, IBM.RECORD.LOCK TO IBM.RECORD.LOCK
  896.       IF EC <> 0 THEN _
  897.          GOTO 29920
  898.       END SUB
  899. ' $SUBTITLE: 'UPDATEC - update of callers log on exiting'
  900. ' $PAGE
  901. '
  902. '  SUBROUTINE NAME    -- UPDATEC
  903. '
  904. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  905. '                        CALLERS.FILE.INDEX!
  906. '                        FIRST.NAME$
  907. '                        HHH
  908. '                        LAST.NAME$
  909. '                        MMM
  910. '                        NG$
  911. '                        SSS
  912. '                        SYSOP.FIRST.NAME$
  913. '                        SYSOP.LAST.NAME$
  914. '
  915. '  OUTPUT PARAMETERS  -- CALLERS.RECORD$
  916. '                        CALLERS.FILE.INDEX!
  917. '                        SYSOP
  918. '
  919. '  SUBROUTINE PURPOSE -- UPDATE THE CALLERS FILE AT LOGOFF SO THAT THE NUMBER
  920. '                        OF HOURS, MINUTES, AND SECONDS FOR THE SESSION ARE
  921. '                        RECORDED AS THE LAST 9 CHARACTERS OF THE 64-CHARACTER
  922. '                        CALLERS FILE RECORD
  923. '
  924.       SUB UPDATEC STATIC
  925.       ON ERROR GOTO 65000
  926.       IF CALLERS.FILE.PREFIX$ = "" THEN _              'KG102705
  927.          EXIT SUB
  928. '
  929. ' ****  UPDATE CALLERS FILE AT LOGOFF  ****
  930. '
  931. 43050 FIELD 4,55 AS CALLERS.RECORD$,3 AS HOURS$,3 AS MINUTES$,3 AS SECONDS$
  932.       LSET CALLERS.RECORD$ = MID$(NG$,65,55)
  933.       LSET HOURS$ = STR$(HHH)
  934.       LSET MINUTES$ = STR$(MMM)
  935.       LSET SECONDS$ = STR$(SSS)
  936.       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
  937.       PUT 4,CALLERS.FILE.INDEX!
  938.       FIELD 4,64 AS CALLERS.RECORD$
  939.       LSET CALLERS.RECORD$ = LEFT$(NG$,64)
  940.       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
  941.       PUT 4,CALLERS.FILE.INDEX!
  942. 43060 LSET CALLERS.RECORD$ = STRING$(64,CHR$(0))
  943.       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
  944.       PUT 4,CALLERS.FILE.INDEX!
  945.       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
  946.       PUT 4,CALLERS.FILE.INDEX!
  947.       IF ORIG.CALLERS$ <> CALLERS.FILE$ THEN _
  948.          CALLERS.FILE$ = ORIG.CALLERS$ : _
  949.          CALL SETCALL : _
  950.          GOTO 43050
  951.       END SUB
  952. ' $SUBTITLE: 'FINDFREE - subroutine to find space on a device'
  953. ' $PAGE
  954. '
  955. '  SUBROUTINE NAME    -- FINDFREE
  956. '
  957. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  958. '                        Z$                        NAME OF FILE TO FIND
  959. '
  960. '  OUTPUT PARAMETERS  -- FREE.SPACE$               NUMBER OF BYTES FREE
  961. '
  962. '  SUBROUTINE PURPOSE -- TO DETERMINE AMOUNT OF FREE SPACE ON A DEVICE
  963. '
  964.       SUB FINDFREE STATIC
  965.       ON ERROR GOTO 65000
  966.       EC = 0
  967. 52000 IF TURBO.RBBS THEN _
  968.          GOTO 52003
  969.       FREE.SPACE$ = ""
  970.       CLS
  971.       EC = 0
  972. 52001 FILES Z$
  973.       IF EC = 53 AND (Z$ = COMMENTS.FILE$ OR Z$ = UPLOAD.DRIVE.FILE$ ) THEN _
  974.          CALL OPENOUTW (Z$) : _
  975.          GOTO 52000
  976.       IF EC = 53 AND Z$ = UPLOAD.DIRECTORY$ THEN _
  977.          A$ = "Upload directory missing.  Tell SYSOP" : _
  978.          SUBROUTINE.PARAMETER = 6 : _
  979.          CALL TPUT : _
  980.          GOTO 52002
  981.       FOR X = 1 TO 25
  982.          FREE.SPACE$ = FREE.SPACE$ + CHR$(SCREEN (3,X))
  983.       NEXT
  984. 52002 SUBROUTINE.PARAMETER = 1
  985.       CALL LINE25
  986.       EXIT SUB
  987. 52003 AX% = 0
  988.       BX% = 0
  989.       CX% = 0
  990.       DX% = 0
  991.       IF MID$(Z$,2,1) = ":" THEN _
  992.          AX% = ASC(Z$) - ASC("A") + 1
  993.       CALL RBBSFREE (AX%,BX%,CX%,DX%)
  994.       I# = CDBL(AX%) * BX%
  995.       I# = I# * CX%
  996.       FREE.SPACE$ = STR$(I#) + _
  997.                     " bytes free"
  998.       END SUB
  999. ' $SUBTITLE: 'OPENWORK - subroutine to open RBBS-PC's work file (2)'
  1000. ' $PAGE
  1001. '
  1002. '  SUBROUTINE NAME    -- OPENWORK
  1003. '
  1004. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1005. '                        FILE.NAME$                NAME OF FILE TO FIND
  1006. '                        SHARE.IT                  USE DOS' "SHARE" FACILITIES
  1007. '
  1008. '  OUTPUT PARAMETERS  -- EC                        ERROR CODE
  1009. '
  1010. '  SUBROUTINE PURPOSE -- TO OPEN RBBS-PC'S "WORK" FILE (NUMBER 2)
  1011. '
  1012.       SUB OPENWORK (FILNAME$) STATIC
  1013.       ON ERROR GOTO 65000
  1014. 58000 CLOSE 2
  1015. 58010 EC = 0
  1016. 58020 IF SHARE.IT THEN _
  1017.          OPEN FILNAME$ FOR INPUT SHARED AS #2 _
  1018.       ELSE OPEN "I",2,FILNAME$
  1019.       IF EC = 52 THEN _
  1020.          GOTO 58010
  1021. 58030 END SUB
  1022. ' $SUBTITLE: 'OPENFMS - subroutine to open the FMS directory'
  1023. ' $PAGE
  1024. '
  1025. '  SUBROUTINE NAME    -- OPENFMS
  1026. '
  1027. '  INPUT PARAMETERS   -- PARAMETER                      MEANING
  1028. '                        SHARE.IT                DOS SHARING FLAG
  1029. '                        FMS.DIRECTORY$        NAME OF FMS DIRECTORY
  1030. '
  1031. '  OUTPUT PARAMETERS  -- LAST.REC                NUMBER OF THE LAST
  1032. '                                                RECORD IN THE FILE
  1033. '
  1034. '  SUBROUTINE PURPOSE -- TO OPEN THE UPLOAD DIRECTORY AS A RANDOM FILE AND FIND
  1035. '                        THE NUMBER OF THE LAST RECORD IN THE FILE.
  1036. '
  1037.       SUB OPENFMS (LAST.REC) STATIC
  1038. 58190 ON ERROR GOTO 65000
  1039.       FILE.LENGTH = 38 + MAX.DESC.LEN
  1040.       CLOSE 2
  1041.       IF ACTIVE.FMS.DIRECTORY$ = "" THEN _
  1042.          IF MENU.INDEX = 6 THEN _
  1043.             ACTIVE.FMS.DIRECTORY$ = LIBRARY.DIRECTORY$ _
  1044.          ELSE ACTIVE.FMS.DIRECTORY$ = FMS.DIRECTORY$
  1045.       IF SHARE.IT THEN _
  1046.          OPEN ACTIVE.FMS.DIRECTORY$ FOR RANDOM SHARED AS #2 LEN=FILE.LENGTH _
  1047.       ELSE OPEN "R",2,ACTIVE.FMS.DIRECTORY$,FILE.LENGTH
  1048.       'IF EC > 0 THEN _
  1049.       '   CALL QTPUT ("Drive/path does not exist or bad name for FMS dir " + _
  1050.       '               ACTIVE.FMS.DIRECTORY$,1) : _
  1051.       '   END
  1052.       IF EC > 0 THEN
  1053.       EC = 0 
  1054. CALL QTPUT (CHR$(7)+"Error Has Occured...try again !!!!!  " ,1)
  1055. LAST.REC =0
  1056. EXIT SUB
  1057. END IF
  1058.       LAST.REC = LOF(2)/FILE.LENGTH
  1059.       IF ACTIVE.FMS.DIRECTORY$ = PREV.FMS$ THEN _
  1060.          EXIT SUB
  1061.       PREV.FMS$ = ACTIVE.FMS.DIRECTORY$
  1062.       FIELD 2, FILE.LENGTH AS FMS.REC$
  1063.       GET #2,1
  1064.       A = (LEFT$(FMS.REC$,4) <> "\FMS")
  1065.       UPINC = 2*(INSTR(FMS.REC$," TOP ") = 0 OR A) + 1
  1066.       DATE.ORDERED.FMS = A OR (INSTR(FMS.REC$," NOSORT") = 0)
  1067.       END SUB
  1068. ' $SUBTITLE: 'OPENOUTW - subroutine to open output work file (2)'
  1069. ' $PAGE
  1070. '
  1071. '  SUBROUTINE NAME    -- OPENOUTW
  1072. '
  1073. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1074. '                        FILE.NAME$                NAME OF FILE TO FIND
  1075. '                        SHARE.IT                  USE DOS' "SHARE" FACILITIES
  1076. '
  1077. '  OUTPUT PARAMETERS  -- EC                        ERROR CODE
  1078. '
  1079. '  SUBROUTINE PURPOSE -- TO OPEN RBBS-PC'S "WORK" FILE (NUMBER 2) FOR OUTPUT
  1080. '
  1081.       SUB OPENOUTW (FILNAME$) STATIC
  1082.       ON ERROR GOTO 65000
  1083. 58220 CLOSE 2
  1084. 58225 EC = 0
  1085. 58230 IF SHARE.IT THEN _
  1086.          OPEN FILNAME$ FOR OUTPUT SHARED AS #2 _
  1087.       ELSE OPEN "O",2,FILNAME$
  1088. 58235 END SUB
  1089. ' $SUBTITLE: 'KILLWORK - subroutine to delete a "work" file'
  1090. ' $PAGE
  1091. '
  1092. '  SUBROUTINE NAME    -- KILLWORK
  1093. '
  1094. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1095. '                        FILNAME$                NAME OF FILE TO DELETE
  1096. '
  1097. '  OUTPUT PARAMETERS  -- EC                        ERROR CODE
  1098. '
  1099. '  SUBROUTINE PURPOSE -- TO DELETE A RBBS-PC "WORK" FILE
  1100. '
  1101.       SUB KILLWORK (FILNAME$) STATIC
  1102.       ON ERROR GOTO 65000
  1103. 58260 CLOSE 2
  1104.        EC = 0
  1105. 58270 KILL FILNAME$
  1106. 58275 END SUB
  1107. ' $SUBTITLE: 'GETPASWD - subroutine to read the "passwords" file'
  1108. ' $PAGE
  1109. '
  1110. '  SUBROUTINE NAME    -- GETPASWD
  1111. '
  1112. '                          PARAMETER             MEANING
  1113. '  INPUT PARAMETERS   -- FILE # 2 OPENED
  1114. '
  1115. '  OUTPUT PARAMETERS  -- TEMP.PASSWORD$
  1116. '                        TEMP.SECURITY.LEVEL
  1117. '                        TEMP.TIME.ALLOWED
  1118. '                        TEMP.REG.PERIOD
  1119. '                        TEMP.MAX.PER.DAY
  1120. '
  1121. '  SUBROUTINE PURPOSE -- TO READ THE RBBS-PC "PASSWORDS" FILE
  1122. '
  1123. 58280 SUB GETPASWD STATIC
  1124.       ON ERROR GOTO 65000
  1125.       EC = 0
  1126.       INPUT #2,TEMP.PASSWORD$,     TEMP.SECURITY.LEVEL, _
  1127.                TEMP.TIME.ALLOWED,  TEMP.MAX.PER.DAY, _
  1128.                TEMP.REG.PERIOD,    START.TIME, _
  1129.                END.TIME,           BYTE.METHOD, _
  1130.                RATIO.RESTRICTION#, INITIAL.CREDIT#, _
  1131.                TEMP.TIME.LOCK
  1132. 58285 END SUB
  1133. ' $SUBTITLE: 'READDIR - subroutine to read the "DIR" files'
  1134. ' $PAGE
  1135. '
  1136. '  SUBROUTINE NAME    -- READDIR
  1137. '
  1138. '                          PARAMETER             MEANING
  1139. '  INPUT PARAMETERS   -- FILE # 2 OPENED
  1140. '                        WHICH.LINE              HOW MANY LINES TO ADVANCE
  1141. '
  1142. '  OUTPUT PARAMETERS  -- A$
  1143. '
  1144. '  SUBROUTINE PURPOSE -- TO READ POSSIBLE "DIR" FILES
  1145. '
  1146. 58290 SUB READDIR (WHICH.LINE) STATIC
  1147.       ON ERROR GOTO 65000
  1148.       EC = 0
  1149.       FOR I = 1 TO WHICH.LINE
  1150.          LINE INPUT #2,A$
  1151.       NEXT
  1152. 58295 END SUB
  1153. ' $SUBTITLE: 'READPARMS - subroutine to read parameter values'
  1154. ' $PAGE
  1155. '
  1156. '  SUBROUTINE NAME    -- READPARMS
  1157. '
  1158. '                          PARAMETER             MEANING
  1159. '  INPUT PARAMETERS   -- FILE # 2 OPENED
  1160. '                        NUM.PARMS               # parameters to read
  1161. '                        WHICH.LINE              Which set of parms to return
  1162. '  OUTPUT PARAMETERS  -- ARA.TO.USER$            Array of string values
  1163. '                        FILE.SECURITY
  1164. '                        FILE.PASSWORD$
  1165. '
  1166. '  SUBROUTINE PURPOSE -- To read different values, where values are
  1167. '                        separated by a comma or carriage-return-line-feed.
  1168. '
  1169. 58300 SUB READPARMS (ARA.TO.USE$(1),NUM.PARMS,WHICH.LINE) STATIC
  1170.       ON ERROR GOTO 65000
  1171.       EC = 0
  1172.       FOR J = 1 TO WHICH.LINE
  1173.          FOR I = 1 TO NUM.PARMS
  1174.             INPUT #2,ARA.TO.USE$(I)
  1175.          NEXT
  1176.       NEXT
  1177. 58305 END SUB
  1178. ' $SUBTITLE: 'READANY - subroutine to read file 2 into A$'
  1179. ' $PAGE
  1180. '
  1181. '  SUBROUTINE NAME    -- READANY
  1182. '
  1183. '                          PARAMETER             MEANING
  1184. '  INPUT PARAMETERS   -- FILE # 2 OPENED
  1185. '
  1186. '  OUTPUT PARAMETERS  -- A$
  1187. '
  1188. '  SUBROUTINE PURPOSE -- TO READ FILE #2 INTO A$
  1189. '
  1190. 58310 SUB READANY STATIC
  1191.       ON ERROR GOTO 65000
  1192.       EC = 0
  1193.       INPUT #2,A$
  1194. 58315 END SUB
  1195. ' $SUBTITLE: 'PRINTWRK - subroutine to print to file 2'
  1196. ' $PAGE
  1197. '
  1198. '  SUBROUTINE NAME    -- PRINTWRK
  1199. '
  1200. '                          PARAMETER             MEANING
  1201. '  INPUT PARAMETERS   -- FILE # 2 OPENED
  1202. '                        STRING TO WRITE OUT
  1203. '
  1204. '  OUTPUT PARAMETERS  -- NONE
  1205. '
  1206. '  SUBROUTINE PURPOSE -- TO PRINT A STRING TO FILE #2
  1207. '
  1208. 58320 SUB PRINTWRK (STRNG$) STATIC
  1209.       ON ERROR GOTO 65000
  1210.       EC = 0
  1211.       PRINT #2,STRNG$;
  1212. 58325 END SUB
  1213. ' $SUBTITLE: 'GETWORK - subroutine to read file 2'
  1214. ' $PAGE
  1215. '
  1216. '  SUBROUTINE NAME    -- GETWORK
  1217. '
  1218. '                          PARAMETER             MEANING
  1219. '  INPUT PARAMETERS   -- REC.LEN            Length of record
  1220. '
  1221. '  OUTPUT PARAMETERS  -- NONE
  1222. '
  1223. '  SUBROUTINE PURPOSE -- TO READ A RECORD FROM FILE #2
  1224. '
  1225. 58330 SUB GETWORK (REC.LEN) STATIC
  1226.       ON ERROR GOTO 65000
  1227.       EC = 0
  1228.       FIELD 2, REC.LEN AS DOWNLOAD.RECORD$
  1229.       GET 2,(LOC(2)+1)
  1230. 58335 END SUB
  1231. ' $SUBTITLE: 'OPENWRKA - subroutine to open output work file (2)'
  1232. ' $PAGE
  1233. '
  1234. '  SUBROUTINE NAME    -- OPENWRKA
  1235. '
  1236. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1237. '                        FILNAME$                  NAME OF FILE TO FIND
  1238. '                        SHARE.IT                  USE DOS' "SHARE" FACILITIES
  1239. '
  1240. '  OUTPUT PARAMETERS  -- EC                        ERROR CODE
  1241. '
  1242. '  SUBROUTINE PURPOSE -- TO OPEN RBBS-PC'S "WORK" FILE (NUMBER 2) FOR APPENDED
  1243. '                        OUTPUT
  1244. '
  1245. 58340 SUB OPENWRKA (FILNAME$) STATIC
  1246.       ON ERROR GOTO 65000
  1247.       CLOSE 2
  1248.       EC = 0
  1249.       IF SHARE.IT THEN _
  1250.          OPEN FILNAME$ FOR APPEND SHARED AS #2 _
  1251.       ELSE OPEN "A",2,FILNAME$
  1252. 58345 END SUB
  1253. ' $SUBTITLE: 'PRNTWRKA - subroutine to print to file 2 with CR'
  1254. ' $PAGE
  1255. '
  1256. '  SUBROUTINE NAME    -- PRNTWRKA
  1257. '
  1258. '                          PARAMETER             MEANING
  1259. '  INPUT PARAMETERS   -- FILE # 2 OPENED
  1260. '                        STRING TO WRITE OUT
  1261. '
  1262. '  OUTPUT PARAMETERS  -- NONE
  1263. '
  1264. '  SUBROUTINE PURPOSE -- TO PRINT A STRING TO FILE #2 FOLLOWED BY A CARRIAGE
  1265. '                        RETURN
  1266. '
  1267. 58350 SUB PRNTWRKA (STRNG$) STATIC
  1268.       ON ERROR GOTO 65000
  1269.       EC = 0
  1270.       PRINT #2,STRNG$
  1271. 58355 END SUB
  1272. ' $SUBTITLE: 'CHECKINT - subroutine to check input is an integer'
  1273. ' $PAGE
  1274. '
  1275. '  SUBROUTINE NAME    -- CHECKINT
  1276. '
  1277. '                          PARAMETER             MEANING
  1278. '  INPUT PARAMETERS   -- STRNG$         STRING TO VERIFY CAN BE AN INTEGER
  1279. '
  1280. '  OUTPUT PARAMETERS  -- EC             = 0 MEANS IT IS AN INTEGER VALUE
  1281. '                                      <> 0 MEANS IT IS NOT AN INTEGER VALUE
  1282. '
  1283. '  SUBROUTINE PURPOSE -- TO PRINT VALIDATE A STRING CAN HAVE AN INTEGER VALUE
  1284. '
  1285. 58360 SUB CHECKINT (STRNG$) STATIC
  1286.       ON ERROR GOTO 65000
  1287.       EC = 0
  1288.       TESTED.INTEGER.VALUE = VAL(STRNG$)
  1289. 58365 END SUB
  1290. ' $SUBTITLE: 'PUTCOM -- subroutine to write to communications port'
  1291. ' $PAGE
  1292. '
  1293. '  SUBROUTINE NAME    -- PUTCOM
  1294. '
  1295. '  INPUT PARAMETERS   --   PARAMETER     MEANING
  1296. '                          STNG$       STRING TO PRINT TO COMM PORT
  1297. '                        FLOW.CONTROL  WHETHER USING CLEAR TO SEND FOR FLOW
  1298. '                                      CONTROL BETWEEN THE PC AND THE MODEM
  1299. '
  1300. '  OUTPUT PARAMETERS  --
  1301. '
  1302. '  SUBROUTINE PURPOSE -- CHECKS FOR CARRIER DROP AND FLOW CONTROL (I.E. "CLEAR
  1303. '                        TO SEND" SIGNAL) BEFORE WRITING TO THE COMMUNICATIONS
  1304. '                        PORT.
  1305. '
  1306. 59650 SUB PUTCOM (STRNG$) STATIC
  1307.       ON ERROR GOTO 65000
  1308.       IF LOCAL.USER THEN _
  1309.          EXIT SUB
  1310.       CALL CARRIER
  1311.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1312.          EXIT SUB
  1313.       IF NOT XOFF.ED THEN _
  1314.          GOTO 59652
  1315.       SUBROUTINE.PARAMETER = 1
  1316.       CALL LINE25
  1317.       Y$ = XOFF$
  1318.       CALL SETABORT (X!,WAIT.BEFORE.DISCONNECT)
  1319.       WHILE Y$ = XOFF$ AND SUBROUTINE.PARAMETER <> -1
  1320.          CHAR% = -1
  1321.          WHILE CHAR% = -1 AND SUBROUTINE.PARAMETER <> -1
  1322.             GOSUB 59654
  1323.          WEND
  1324.          IF CHAR% <> -1 THEN _
  1325.             CALL GETCOM(Y$) : _
  1326.             IF XON.XOFF AND Y$ <> XON$ THEN _
  1327.                Y$ = XOFF$
  1328.       WEND
  1329.       XOFF.ED = FALSE
  1330.       SUBROUTINE.PARAMETER = 1
  1331.       CALL LINE25
  1332. 59652 NOT.CTS = FALSE
  1333.       IF NOT FOSSIL THEN _
  1334.          PRINT #3,STRNG$; : _
  1335.          EXIT SUB
  1336.       IF STRNG$ = "" THEN _
  1337.          EXIT SUB
  1338.       FOR N = 1 TO LEN(STRNG$)
  1339.          CHAR% = ASC(MID$(STRNG$,N,1))
  1340. 59653  CALL FOSTXCHARNW(COMPORT%,CHAR%,RESULT%)
  1341.        IF RESULT% = 0 THEN _
  1342.           GOTO 59653
  1343.      NEXT
  1344.       EXIT SUB
  1345. 59654 CALL EOFCOMM (CHAR%)
  1346.       CALL GOIDLE
  1347.       CALL CARRIER
  1348.       CALL CHKTREMAIN (X!)
  1349.       RETURN
  1350.       END SUB
  1351. ' $SUBTITLE: 'PUTWORK -- subroutine to write to upload files'
  1352. ' $PAGE
  1353. '
  1354. '  SUBROUTINE NAME    -- PUTWORK
  1355. '
  1356. '  INPUT PARAMETERS   --   PARAMETER     MEANING
  1357. '                          STNG$       STRING TO WRITE TO FILE
  1358. '                          REC.NUM     RECORD NUMBER TO WRITE
  1359. '                          REC.LEN     LENGTH OF RECORD TO WRITE
  1360. '
  1361. '  OUTPUT PARAMETERS  --
  1362. '
  1363. '  SUBROUTINE PURPOSE -- WRITES UPLOADED FILE RECORDS TO WORK FILE
  1364. '
  1365. 59660 SUB PUTWORK (STRNG$,REC.NUM,REC.LEN) STATIC
  1366.       ON ERROR GOTO 65000
  1367.       FIELD #2,REC.LEN AS UPLOAD.RECORD$
  1368.       LSET UPLOAD.RECORD$ = STRNG$
  1369.       REC.NUM = REC.NUM + 1
  1370.       PUT #2,REC.NUM
  1371.       END SUB
  1372. '
  1373. ' $SUBTITLE: 'DGSALIAS - Subroutine to Create/Update Alias Info file'
  1374. ' $PAGE
  1375. '
  1376. '  SUBROUTINE NAME    -- DGSALIAS
  1377. '
  1378. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1379. '                         GRN$                        CONFERENCE NAME
  1380. '                         ORIG.USER.NAME$             USERS - LOG ON NAME
  1381. '                         DGS.ALIAS$                  USERS - ALIAS NAME
  1382. '                         DGS.STL$                    NULL FIRST TIME IN
  1383. '                                                     'STILL' IF ALIAS EXISTS
  1384. '                                                     OR REAL NAME
  1385. '                         DGS.FILE.NAME$              CONFERENCE ALIAS FILE
  1386. '
  1387. '  OUTPUT PARAMETERS  --  GRN$ ORIG.USER.NAME$ DGS.ALIAS$ DGS.STL$
  1388. '                         DGS.FILE.NAME$
  1389. '
  1390. '  SUBROUTINE PURPOSE --  TO READ CONFA.DEF AND GET USERS ALIAS OR
  1391. '                         CREATE ONE
  1392. '
  1393.      SUB DGSALIAS (GRN$,ORIG.USER.NAME$,DGS.ALIAS$,DGS.STL$,DGS.FILE.NAME$) STATIC
  1394. '
  1395.      IF DGS.STL$ = "" THEN
  1396.     CONFA.DEF.FLAG = 0
  1397.     CALL BRKFNAME (MAIN.USER.FILE$,DRV$,PREFIX$,EXT$,TRUE)
  1398.     DGS.FILE.NAME$ = DRV$ + GRN$ + "A.DEF"
  1399.     CALL FINDIT (DGS.FILE.NAME$)
  1400.     IF OK THEN
  1401.        CONFA.DEF.FLAG = TRUE
  1402.     END IF
  1403.     IF CONFA.DEF.FLAG = TRUE THEN
  1404.        OPEN "I", 7, DGS.FILE.NAME$
  1405.        DGS.ALIAS$ = ""
  1406.        WHILE DGS.ALIAS$ = "" AND NOT EOF(7)
  1407.           INPUT #7, DGS.USER.NAME$, DGS.TEMP.ALIAS$
  1408.           DGS.UNL = LEN(DGS.USER.NAME$)
  1409.           IF DGS.USER.NAME$ = LEFT$(ORIG.USER.NAME$,DGS.UNL) THEN
  1410.          DGS.ALIAS$ = DGS.TEMP.ALIAS$
  1411.           END IF
  1412.        WEND
  1413.        CLOSE 7
  1414.     ELSE
  1415.        DGS.ALIAS$ = "NO CONFA.DEF"
  1416.        EXIT SUB
  1417.     END IF
  1418.      END IF
  1419.      CALL GOODALS (GRN$,ORIG.USER.NAME$,DGS.ALIAS$,DGS.STL$,DGS.FILE.NAME$)
  1420.      END SUB
  1421. '
  1422. '
  1423. ' $SUBTITLE: 'GOODALS - Subroutine to Make Sure Alias Good'
  1424. ' $PAGE
  1425. '
  1426. '  SUBROUTINE NAME    -- GOODALS
  1427. '
  1428. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1429. '                         GRN$                        CONFERENCE NAME
  1430. '                         ORIG.USER.NAME$             USERS - LOG ON NAME
  1431. '                         DGS.ALIAS$                  USERS - ALIAS NAME
  1432. '                         DGS.STL$                    NULL FIRST TIME IN
  1433. '                                                     'STILL' IF ALIAS EXISTS
  1434. '                                                     OR REAL NAME
  1435. '                         DGS.FILE.NAME$              CONFERENCE ALIAS FILE
  1436. '
  1437. '  OUTPUT PARAMETERS  --  GRN$ ORIG.USER.NAME$ DGS.ALIAS$ DGS.STL$
  1438. '                         DGS.FILE.NAME$
  1439. '
  1440. '  SUBROUTINE PURPOSE --  TO READ CONFA.DEF AND SEE IF GET USERS ALIAS IS
  1441. '                         ALREADY IN USE OR A REAL NAME
  1442. '
  1443.      SUB GOODALS (GRN$,ORIG.USER.NAME$,DGS.ALIAS$,DGS.STL$,DGS.FILE.NAME$) STATIC
  1444. '
  1445.      IF DGS.ALIAS$ = "" THEN
  1446.     DGS.SFN.SLN$ = SYSOP.FIRST.NAME$+" "+SYSOP.LAST.NAME$
  1447.     A$ = "Do you" +DGS.STL$+ " want to use an Alias? (Y,[N])"
  1448.     SUBROUTINE.PARAMETER = 1
  1449.     CALL TGET
  1450.     IF YES THEN
  1451.        ABFLG$ = ""
  1452.        A$ = "Enter Alias (31 Char. Max.) "
  1453.        SUBROUTINE.PARAMETER = 1
  1454.        CALL TGET
  1455.        CALL ALLCAPS (B$)
  1456.        IF B$ = "" OR INSTR(SPACE$(31),B$) > 0 THEN
  1457.           B$ = ""
  1458.           ABFLG$ = "Alias Must NOT be Blank"
  1459.        END IF
  1460.        IF LEN(B$) > 31 THEN
  1461.           B$= ""
  1462.           ABFLG$ = "Length Must NOT Exceed 31 Characters"
  1463.        END IF
  1464.        IF B$ = "SYSOP" OR B$ = DGS.SFN.SLN$ THEN
  1465.           A$ = CHR$(7)+CHR$(7)
  1466.           A$ = A$ + "Wrong Answer! Alias Request Denied!"
  1467.           A$ = A$ + CHR$(13) + "Contact Sysop for Alias Retry"
  1468.           CALL QTPUT (A$,2)
  1469.           DGS.ALIAS$ = ORIG.USER.NAME$+CHR$(250)
  1470.           ACTIVE.USER.NAME$ = ORIG.USER.NAME$+CHR$(250)
  1471.           FIRST.NAME$ = ORIG.USER.NAME$+CHR$(250)
  1472.        ELSE
  1473.           OPEN "I", 7, DGS.FILE.NAME$
  1474.           WHILE ABFLG$ = "" AND NOT EOF(7)
  1475.          INPUT #7, DGS.USER.NAME$, DGS.TEMP.ALIAS$
  1476.          IF B$ = DGS.USER.NAME$ THEN
  1477.             ABFLG$ = " is a Real User"
  1478.          ELSE
  1479.             IF B$ = DGS.TEMP.ALIAS$ THEN
  1480.                ABFLG$ = " has Already been Used"
  1481.             END IF
  1482.          END IF
  1483.           WEND
  1484.           CLOSE 7
  1485.           IF ABFLG$="" THEN
  1486.          DGS.ALIAS$ = B$
  1487.          ACTIVE.USER.NAME$ = B$
  1488.          FIRST.NAME$ = B$
  1489.           ELSE
  1490.          A$="Sorry "+FIRST.NAME$+" but "+B$+ABFLG$
  1491.          CALL QTPUT (A$,1)
  1492.          DGS.STL$ = " still"
  1493.          DGS.ALIAS$ = ""
  1494.           END IF
  1495.        END IF
  1496.     ELSE
  1497.        DGS.ALIAS$ = ORIG.USER.NAME$
  1498.     END IF
  1499.     IF DGS.ALIAS$ <> "" THEN
  1500.        CLOSE 2
  1501.        OPEN "A", 2, DGS.FILE.NAME$
  1502.        WRITE #2, ORIG.USER.NAME$, DGS.ALIAS$
  1503.        CLOSE 2
  1504.     END IF
  1505.      ELSE
  1506.     ACTIVE.USER.NAME$ = DGS.ALIAS$
  1507.     FIRST.NAME$ = DGS.ALIAS$
  1508.      END IF
  1509.  END SUB
  1510. '
  1511. '********************************************************************
  1512. '  THREAD1            First message thread routine                  *
  1513. '  THREAD2            Second message thread routine                 *
  1514. '  THREAD3            Third message thread routine                  *
  1515. '********************************************************************
  1516. '===========================================================================
  1517.  
  1518.  
  1519. ' $SUBTITLE: 'THREAD1 - create/update threaded message file'
  1520. ' $PAGE
  1521. '
  1522. '  SUBROUTINE NAME    -- THREAD1
  1523. '
  1524. '  INPUT PARAMETERS   --    PARAMETER              MEANING
  1525. '                           HIGH.MESSAGE.NUMBER    This reply's message number
  1526. '                           CURRENT.MESSAGE        Message number being replied
  1527. '
  1528. '  OUTPUT PARAMETERS  --     <<NONE>>
  1529. '
  1530. '  SUBROUTINE PURPOSE -- SUBROUTINE TO...
  1531. '
  1532.       SUB THREAD1 (HIGH.MESSAGE.NUMBER,CURRENT.MESSAGE,GRN$) STATIC
  1533.         IF INSTR(GRN$," ") = 0 THEN   'PE102587
  1534.          FILE.NAME$ = GRN$ + "T"  'PE102587
  1535.         ELSE
  1536.            FILE.NAME$ = LEFT$(GRN$,INSTR(GRN$," ")-1)+"T" 'PE102587
  1537.       END IF
  1538.       CURRENT.MESSAGE$ = STR$(CURRENT.MESSAGE)
  1539.       HIGH.MESSAGE.NUMBER$ = STR$(HIGH.MESSAGE.NUMBER)
  1540.       OPEN "R",9,FILE.NAME$,12
  1541.       FIELD 9, 6 AS CM$, 6 AS HMN$
  1542.       LSET CM$ = CURRENT.MESSAGE$
  1543.       LSET HMN$ = HIGH.MESSAGE.NUMBER$
  1544.       PUT #9,INT(LOF(9)/12)+1
  1545.       CLOSE (9)
  1546. 59670 END SUB       ' THREAD1
  1547. '
  1548. ' $SUBTITLE: 'THREAD2 - a message was killed - check threaded message file'
  1549. ' $PAGE
  1550. '
  1551. '  SUBROUTINE NAME    -- THREAD2
  1552. '
  1553. '  INPUT PARAMETERS   --    PARAMETER              MEANING
  1554. '                           MESSAGE.TO.KILL        Killed message's number
  1555. '
  1556. '  OUTPUT PARAMETERS  --     <<NONE>>
  1557. '
  1558. '  SUBROUTINE PURPOSE -- SUBROUTINE TO ...
  1559. '
  1560.       SUB THREAD2 (MESSAGE.TO.KILL,ACTIVE.MESSAGES,GRN$) STATIC
  1561.       IF INSTR(GRN$," ") = 0 THEN     'PE102587
  1562.         FILE.NAME$ = GRN$ + "T"
  1563.       ELSE
  1564.         FILE.NAME$ = LEFT$(GRN$,INSTR(GRN$," ")-1)+"T"
  1565.       END IF
  1566.       OPEN "R",9,FILE.NAME$,12
  1567.       FIELD 9, 6 AS CM$, 6 AS HMN$
  1568.        FOR I = 1 TO INT(LOF(9)/12)
  1569.           GET 9,I
  1570.           IF VAL(CM$) = MESSAGE.TO.KILL THEN     ' MARK THE RECORD
  1571.              LSET CM$ = LEFT$(CM$,5) + "K"
  1572.              PUT 9,I
  1573.           ELSE 
  1574.            IF VAL(HMN$) = MESSAGE.TO.KILL THEN     ' MARK THE RECORD
  1575.               LSET HMN$ = LEFT$(HMN$,5) + "K"
  1576.               LSET CM$ = LEFT$(CM$,5) + "K"
  1577.              PUT 9,I
  1578.           END IF
  1579.        END IF
  1580.       NEXT I
  1581.       CLOSE (9)
  1582. 59680 END SUB      ' THREAD2
  1583. '
  1584. ' $SUBTITLE: 'THREAD3 - a message was killed - check threaded message file'
  1585. ' $PAGE
  1586. '
  1587. '  SUBROUTINE NAME    -- THREAD3
  1588. '
  1589. '  INPUT PARAMETERS   --    PARAMETER              MEANING
  1590. '                           CURRENT.MESSAGE        Message's number
  1591. '
  1592. '  OUTPUT PARAMETERS  --     <<NONE>>
  1593. '
  1594. '  SUBROUTINE PURPOSE -- SUBROUTINE TO ...
  1595. '
  1596.       SUB THREAD3 (CURRENT.MESSAGE,GRN$) STATIC
  1597. IF JUST.SEARCHING THEN _            'PE 01/16/89
  1598.  EXIT SUB                           'PE 01/16/89
  1599.       IF INSTR(GRN$," ") = 0 THEN
  1600.          FILE.NAME$ = GRN$ + "T"
  1601.        ELSE
  1602.          FILE.NAME$ = LEFT$(GRN$,INSTR(GRN$," ")-1)+"T"
  1603.       END IF
  1604.        OPEN "R",9,FILE.NAME$,12 
  1605.        FIELD 9, 6 AS CM$, 6 AS HMN$
  1606.       AA$ = ""
  1607.       ZZ$ = ""
  1608.       FOR I = 1 TO INT(LOF(9)/12)
  1609.           GET 9,I
  1610.          IF RIGHT$(HMN$,1) = "K" THEN 59690
  1611.          IF VAL(CM$) = CURRENT.MESSAGE AND RIGHT$(HMN$,1) <> "K" THEN 
  1612.                 AA$ = AA$ + HMN$
  1613.          END IF 
  1614.           IF VAL(HMN$) = CURRENT.MESSAGE AND RIGHT$(CM$,1) = "K" THEN
  1615.                 ZZ$ = LEFT$(CM$,5) + CX$(1)+"(deleted) "+EMPHASIZE.OFF$
  1616.          END IF
  1617.           IF VAL(HMN$) = CURRENT.MESSAGE AND RIGHT$(CM$,1) <> "K" THEN 
  1618.                 ZZ$ = CM$
  1619.          END IF
  1620. 59690 NEXT I
  1621.       IF LEN(AA$) > 0 THEN 
  1622. CALL QTPUT(FG.3$+"   Reply(ies) in message number(s): "+CX$(4) + AA$+EMPHASIZE.OFF$,1)
  1623.       END IF
  1624.       IF LEN(ZZ$) > 0 THEN 
  1625. CALL QTPUT (FG.4$+"   This message is in reply to message " +FG.1$+ ZZ$+EMPHASIZE.OFF$,1)
  1626.       END IF
  1627. CALL QTPUT (CX$(1)+ "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"+EMPHASIZE.OFF$,1)
  1628.       CLOSE (9)
  1629. 59695 END SUB      ' THREAD3
  1630. '
  1631. ' $SUBTITLE: 'THREAD4 - UPDATE CONFR.DEF FILE FOR MESSAGE RECOVERY'
  1632. ' $PAGE
  1633. '
  1634. '  SUBROUTINE NAME    -- THREAD4
  1635. '
  1636. '  INPUT PARAMETERS   --    PARAMETER            MEANING
  1637. '
  1638. '                           MESSAGE.TO.RECOVER   MESSAGE NUMBER BEING RECOVERED
  1639. '                           FIRST.MESSAGE.RECORD NOT USED HERE BUT PASSED IN
  1640. '                                                FROM RBBS CALL TO SUB2
  1641. '                           ACTION.FLAG          PASSED FROM SUB2 NEEDED TO
  1642. '                                                GIVE BACK TO RBBS MAIN CODE
  1643. '                           GRN$                 CONFERENCE NAME
  1644. '
  1645. '  OUTPUT PARAMETERS  --      <<NONE>>
  1646. '
  1647. '  SUBROUTINE PURPOSE -- SUBROUTINE - UPDATE CONFR.DEF FILE AFTER MSG RECVRY
  1648. '
  1649.       SUB THREAD4 (MESSAGE.TO.RECOVER,FIRST.MESSAGES.RECORD,ACTION.FLAG,GRN$) STATIC
  1650.       IF INSTR(GRN$," ") = 0 THEN
  1651.          FILE.NAME$ = GRN$ + "T"
  1652.       ELSE
  1653.          FILE.NAME$ = LEFT$(GRN$,INSTR(GRN$," ")-1)+"T"
  1654.       END IF
  1655.       OPEN "R",9,FILE.NAME$,12               'WILL CREATE FILE IF NOT EXIST
  1656.       FIELD 9, 6 AS CM$, 6 AS HMN$
  1657.       FOR I = 1 TO INT(LOF(9)/12)
  1658.           GET 9,I
  1659.           IF VAL(CM$) = MESSAGE.TO.RECOVER THEN
  1660.              LSET CM$ = LEFT$(CM$,5) + " "
  1661.              PUT 9,I
  1662.           ELSE
  1663.               IF VAL(HMN$) = MESSAGE.TO.RECOVER THEN
  1664.                  LSET HMN$ = LEFT$(HMN$,5) + " "
  1665.                  LSET CM$ = LEFT$(CM$,5) + " "
  1666.                  PUT 9,I
  1667.               END IF
  1668.           END IF
  1669.       NEXT I
  1670.       CLOSE (9)
  1671. 59698 END SUB    'THREAD4
  1672. '
  1673. ' $SUBTITLE: 'VIEWTXT - Subroutine to display ASCII file from ARC file'
  1674. ' $PAGE
  1675. '
  1676.   SUB VIEWTXT STATIC
  1677.   ON ERROR GOTO 65000
  1678. '
  1679. 60140 SUBROUTINE.PARAMETER = 1 
  1680. A$ ="T)ype, X)tract, C)ompress, D)ir, H)elp or [Quit]" +CRLF$
  1681. A$ = CRLF$ + A$ + "Enter Choice T,X,C,D,?,H,[Q] "
  1682.         TURBO.KEY = -TURBO.KEY.USER
  1683.         CALL TGET
  1684. IF SUBROUTINE.PARAMETER = -1 THEN_   
  1685.    EXIT SUB
  1686. IF Q = 0 THEN _
  1687.  EXIT SUB          'Pe 05/24/89                    
  1688.         CALL ALLCAPS (B$)
  1689.         X = INSTR("TXCD?HQ",B$)
  1690.      ON X GOTO 60149,60168,60175,60142,60141,60141,60180
  1691. GOTO 60180
  1692. '
  1693. 60141 CALL BUFFILE (HELP.PATH$ + "ZIP" + HELP.EXTENSION$,X)  'Pe 03/26/89
  1694.       GOTO 60140                                             'Pe 03/26/89
  1695. 60142  CALL QTPUT ("Creating file list, one moment please....",1)
  1696.    EXTRACT$ = "DIR "+ ARKVIEW.PATH$+">VUZIP"+NODE.ID$+".LST"
  1697.    SHELL EXTRACT$
  1698. CALL BUFFILE("VUZIP"+NODE.ID$ +".LST",X)
  1699. GOTO 60140
  1700. '
  1701. 60149 SUBROUTINE.PARAMETER = 1
  1702.      A$ = "What file(s) to Type, R)elist or [ENTER] to quit"         'DMOD1
  1703.      CALL TGET
  1704. IF SUBROUTINE.PARAMETER = -1 THEN _
  1705.  EXIT SUB                              'Pe 05/24/89
  1706.        B = 1                                                            'DMOD1
  1707.        IF Q = 0 THEN _                                                  'DMOD1
  1708.         GOTO 60140              'Pe 05/24/89 was Exit Sub
  1709. IF B$ = "R" or B$ = "r" THEN _
  1710.    CALL BUFFILE (ARC.WORK$,X) : _
  1711. GOTO 60149
  1712.        LAST.ARC = Q                                                     'DMOD1
  1713.        FIRST.ARC = B                                                    'DMOD1
  1714.        FOR ARC.INDEX = FIRST.ARC TO LAST.ARC                            'DMOD1
  1715.  Z$ = B$(ARC.INDEX)                                                'DMOD1
  1716.       CALL ALLCAPS (Z$)  
  1717.   IF INSTR(Z$,"*") OR INSTR(Z$,"?") THEN _
  1718.   CALL QTPUT ("Sorry Widcars NOT allowed !!",1) : _
  1719.   GOTO 60149                                           'PEMOD1
  1720.  CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE)                        'DMOD1
  1721.  IF EXT$ = "ARC" OR EXT$ = "COM" OR EXT$ = "EXE" OR EXT$ = "BAS" OR _   'DMOD1
  1722.          EXT$ = "BIN" OR EXT$ = "LIB" OR EXT$ = "OBJ" OR EXT$ = "PIC" THEN _ 
  1723.          CALL QTPUT ("Sorry, only ASCII files can be viewed",1) :_      'DMOD1
  1724.          GOTO 60149                                                     'DMOD1
  1725.       CALL QTPUT ("Please stand by while I extract that file....",1)    'DMOD1
  1726. '
  1727. '
  1728. ' ******* Next 3 lines added for ZIP support    Pe 02/19/89
  1729. IF LAST.EXT$ = "ZIP" THEN _
  1730.  SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PKUNZIP -O " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$ : _
  1731. GOTO 60150
  1732. '
  1733.  IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,2) ="PK" THEN _
  1734.       SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PKXARC -R " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$
  1735.  IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,2) ="AR" THEN _
  1736.       SHOWME$ = LIBRARY.ARCHIVE.PATH$+"ARCE " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$ + " /R"
  1737.  IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,3) ="PAK" THEN _
  1738.       SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PAK /E/WA " + FILE.NAME$ + " "+ ARKVIEW.PATH$+"\"+Z$
  1739. 60150 SHELL SHOWME$                                         'Pe 02/19/89
  1740.       Z$ = ARKVIEW.PATH$ +"\"+ Z$     'Added \ to fix error 63
  1741.       TEMP$ = Z$    
  1742. '
  1743.       CALL BUFFILE (Z$,X)                                             'DMOD1
  1744.         IF NOT OK THEN _
  1745.          CALL QTPUT(CHR$(7)+"File NOT found or bad Spelling",1) :_
  1746.         GOTO 60149
  1747.       CALL KILLWORK(TEMP$)   'get rid of the files that were xtracted   PEMOD1
  1748.        NEXT                                                             'DMOD1
  1749. GOTO 60140
  1750. '
  1751. 60168 SUBROUTINE.PARAMETER = 1
  1752.       CALL SKIPLINE (1)
  1753. 60169  A$ = "What file(s) to Extract, R)elist or [ENTER] quits"+CRLF$ + _
  1754. "Wildcards ARE supported for this feature " +EMPHASIZE.OFF$ 
  1755.     CALL TGET
  1756. IF SUBROUTINE.PARAMETER = -1 THEN _      'Pe 11/29/88
  1757.    EXIT SUB                              'Pe 11/29/88
  1758. IF B$ = "R" or B$ = "r" THEN _
  1759.    CALL BUFFILE (ARC.WORK$,X) : _
  1760.    GOTO 60168
  1761.       B = 1                                                            'DMOD1
  1762.       IF Q = 0 THEN _                                                  'DMOD1
  1763.        EXIT SUB                                                        'DMOD1
  1764.        LAST.ARC = Q                                                    'DMOD1
  1765.        FIRST.ARC = B                                                   'DMOD1
  1766.        FOR ARC.INDEX = FIRST.ARC TO LAST.ARC                           'DMOD1
  1767.   Z$ = B$(ARC.INDEX)                                                   'DMOD1
  1768.      CALL ALLCAPS (Z$)
  1769.      CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE)                        'DMOD1
  1770.      CALL QTPUT ("Please stand by while I extract the file(s)....",1)    'DMOD1
  1771. '
  1772. 'Next 3 lines for ZIP Support Pe 02/19/89
  1773. '
  1774. IF LAST.EXT$ = "ZIP" THEN _
  1775.  SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PKUNZIP -O " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$ : _
  1776. GOTO 60170
  1777. '
  1778. '
  1779.  IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,2) ="PK" THEN _
  1780.       SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PKXARC -R " + FILE.NAME$ + " " + Z$ + " " + ARKVIEW.PATH$
  1781.  IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,2) ="AR" THEN _
  1782.       SHOWME$ = LIBRARY.ARCHIVE.PATH$+"ARCE " + FILE.NAME$ + " " + Z$ + " " + ARKVIEW.PATH$+" /R"
  1783.  IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,3) ="PAK" THEN _
  1784.       SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PAK /E/WA " + FILE.NAME$ + " " + ARKVIEW.PATH$ + "\" +Z$
  1785. '
  1786. 60170  SHELL SHOWME$     'Added line Number Pe 02/19/89
  1787. LOOKFOR$ = ARKVIEW.PATH$ + "\" + Z$
  1788. CALL FINDIT(LOOKFOR$)
  1789.      IF NOT OK THEN _
  1790. CALL QTPUT ("Error extracting " + Z$ + "...file Skipped...",2) : _
  1791.       GOTo 60171
  1792.        CALL QTPUT(Z$+" Is now  Extracted ...",2)
  1793. 60171 NEXT ARC.INDEX
  1794. CALL QTPUT ("Use the C)ompress command to create a ZIP file of Xtracted files",2)
  1795. GOTO 60140
  1796. '
  1797. ' ***  Added choice of Compressing file or taking it as is Pe 03/23/89 ***
  1798. '
  1799. 60175 Subroutine.parameter = 1          'Pe 03/26/89
  1800.       A$ = CRLF$ +"List files about to be Compressed (Y/[N])"
  1801.     CALL TGET
  1802. IF SUBROUTINE.PARAMETER = -1 THEN _      'Pe 03/29/88
  1803.    EXIT SUB                              'Pe 03/29/88
  1804. IF B$ ="N" or B$ = "n" Then _            'Pe 04/07/89
  1805.    GOTO 60179                            'pe 04/07/89
  1806. IF B$ = "Y" or B$ = "y" THEN _           'Pe 03/29/89
  1807.  CALL QTPUT ("Creating file list, one moment please....",1): _
  1808.    EXTRACT$ = "DIR "+ ARKVIEW.PATH$+">VUZIP"+NODE.ID$+".LST" : _
  1809.    SHELL EXTRACT$ : _
  1810. CALL BUFFILE("VUZIP"+NODE.ID$ +".LST",X) : _
  1811. Subroutine.parameter = 1 : _         'Pe 03/26/89
  1812.  A$ = CRLF$ +"Continue with file Compression ([Y]/N) " : _
  1813.     CALL TGET : _
  1814. IF SUBROUTINE.PARAMETER = -1 THEN _      'Pe 03/29/88
  1815.    EXIT SUB                               'Pe 03/29/88
  1816. IF B$ = "N" or B$ = "n" THEN _           'Pe 03/29/89
  1817.  GOTO 60140
  1818.  CALL QTPUT ("One Moment while I Compress the file(s) for you........",1)
  1819. '
  1820. '********** ARC all files in the ARKVIEW.PATH$ into VIEW.ZIP **********
  1821. 'next line adds comment to Zip file if used EDIT to Suite and replace in 60179
  1822. '60179  ZIPME$ = LIBRARY.ARCHIVE.PATH$+"PKZIP -m -ex -z<C:\C3\MPL.CMT " + ARKVIEW.PATH$ + "\VIEW.ZIP " + ARKVIEW.PATH$ + "\*.*"
  1823. ' old code
  1824. 60179  ZIPME$ = LIBRARY.ARCHIVE.PATH$+"PKZIP -m -ex " + ARKVIEW.PATH$ + "\VIEW.ZIP " + ARKVIEW.PATH$ + "\*.*"
  1825. SHELL ZIPME$                   
  1826. ' **** Check to see if Compresion was successfull if NOT then redo *****
  1827. VIEW.FILE.NAME$ = ARKVIEW.PATH$ + "\VIEW.ZIP"   'Pe 03/06/89
  1828. CALL FINDIT (VIEW.FILE.NAME$)
  1829. IF NOT OK THEN _
  1830. CALL QTPUT ( "No files to Compress...you must use the X)tract command first" ,2) : _
  1831. CALL DELAYIT (2) : _
  1832. GOTO 60140
  1833. '
  1834. '
  1835. '********** Tells the caller the name of the file to download **********
  1836. '
  1837. CALL QTPUT (" File has been Compressed and named... VIEW.ZIP....",2)
  1838. CALL QTPUT (CHR$(7)+"To Download this file You MUST enter VIEW.ZIP as the file name",2)
  1839. CALL DELAYIT (3)
  1840. GOTO 60140
  1841. 60180 END SUB
  1842. '
  1843. 64900 ' $SUBTITLE: 'RBBSPLAY -- subroutine to play music'            ' KG122702
  1844. ' $PAGE
  1845. '
  1846. '  SUBROUTINE NAME    -- RBBSPLAY
  1847. '
  1848. '  INPUT PARAMETERS   --   PARAMETER     MEANING
  1849. '                          STRNG$      STRING TO PLAY
  1850. '
  1851. '  OUTPUT PARAMETERS  --
  1852. '
  1853. '  SUBROUTINE PURPOSE -- PLAY MUSIC.  SKIP IF GET AN ERROR.
  1854. '
  1855.       SUB RBBSPLAY (STRNG.TO.PLAY$) STATIC                           ' KG122702
  1856.       PLAY STRNG.TO.PLAY$                                            ' KG122702
  1857.       EC = 0                                                         ' KG122702
  1858.       END SUB                                                        ' KG122702
  1859. '  $SUBTITLE: 'Error Handling for separately compiled subroutines'
  1860. '  $PAGE
  1861. '
  1862. ' *****************************************************************************
  1863. ' *  Error handling for the separately compiled subroutines of RBBS-PC        *
  1864. ' *****************************************************************************
  1865. '
  1866. 65000 IF DEBUG THEN _
  1867.          A$ = "RBBSSUB1 DEBUG Error Trap Entry ERL=" + _
  1868.               STR$(ERL) + _
  1869.               " ERR=" + _
  1870.               STR$(ERR) : _
  1871.          IF PRINTER THEN _
  1872.             CALL PRINTIT(A$) _
  1873.          ELSE CALL LPRNT(A$,1)
  1874.       EC = ERR
  1875. '
  1876. '     SETCALL
  1877. '
  1878.       IF ERL = 110 THEN _
  1879.           RESUME NEXT
  1880. '
  1881. '     OPEN CONFIG FILE
  1882. '
  1883.        IF ERL => 117 AND ERL <= 118 THEN _
  1884.           RESUME NEXT
  1885. '
  1886. '     OPEN COM PORT ERROR HANDLING
  1887. '
  1888.       IF ERL = 200 THEN _
  1889.          CLS : _
  1890.    CALL PSCRN (COM.PORT$ + " does not exit/not responding (Error" + STR$(ERR)) : _ ' KG120905
  1891.          STOP
  1892. '
  1893. '     GETCOM ERROR HANDLING
  1894. '
  1895.        IF ERL = 1420 AND ERR = 57 THEN _
  1896.           RESUME NEXT
  1897.        IF ERL = 1420 AND ERR = 69 THEN _
  1898.           SUBROUTINE.PARAMETER = -1 :_
  1899.           RESUME NEXT
  1900. '
  1901. '      OPENRESEQ ERROR HANDLING
  1902. '
  1903.        IF ERL = 1481 THEN _
  1904.            EC = ERR : _
  1905.            RESUME NEXT
  1906. '
  1907. '      OPENUSER ERROR HANDLING
  1908. '
  1909.        IF ERL = 9400 AND ERR = 75 AND SHARE.IT THEN _
  1910.           CALL DELAYIT (30) : _
  1911.           RESUME
  1912. '
  1913. '      FINDUSER ERROR HANDLING
  1914. '
  1915.        IF ERL = 12610 THEN _
  1916.           RESUME NEXT
  1917. '
  1918. '     UPDTCALR ERROR HANDLING
  1919. '
  1920.        IF ERL = 13663 THEN _
  1921.           RESUME NEXT
  1922.        IF ERL = 13672 AND ERR = 61 THEN _                  'KG102502
  1923.           CALL QTPUT ("Disk Full",1) : _
  1924.           IF DISKFULL.GO.OFFLINE THEN _
  1925.              GOTO 65010 _
  1926.           ELSE RESUME NEXT
  1927.        IF ERL = 13672 THEN _                                         ' KG102502
  1928.           CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! - 1 : _          ' KG102502
  1929.           RESUME NEXT                                                ' KG102502
  1930. '
  1931. '     PRINTER ERROR HANDLING
  1932. '
  1933.        IF ERL = 13674 THEN _
  1934.           PRINTER = FALSE : _
  1935.           RESUME
  1936. '
  1937. '      CHANGEDIR ERROR HANDLING
  1938. '
  1939.        IF ERL = 20103 THEN _
  1940.           OK = FALSE : _
  1941.           RESUME NEXT
  1942. '
  1943. '     FINDIT ERROR HANDLING
  1944. '
  1945.        IF ERL = 20221 THEN _
  1946.           RESUME NEXT
  1947.        IF ERL = 20223 AND EC = 58 THEN _
  1948.           EC = 64 : _
  1949.           OK = FALSE : _
  1950.           RESUME NEXT
  1951.        IF ERL = 20223 AND EC = 76 THEN _
  1952.           CALL LPRNT("Bad path.  File name is " + FILNAME$,1) : _
  1953.           EC = 76 : _
  1954.           OK = FALSE : _
  1955.           RESUME NEXT
  1956.        IF ERL => 20221 AND ERL <= 20223 AND EC = 70 _
  1957.           AND NETWORK.TYPE = 6 THEN _
  1958.              EC = 0 : _
  1959.              RESUME NEXT
  1960.        IF ERL => 20221 AND ERL <= 20223 THEN _
  1961.           RESUME
  1962. '
  1963. '     FLUSHCOM ERROR HANDLING
  1964. '
  1965.        IF ERL = 20311 AND ERR = 57 THEN _
  1966.           RESUME NEXT
  1967.        IF ERL = 20311 AND ERR = 69 THEN _
  1968.           ABORT = TRUE : _
  1969.           SUBROUTINE.PARAMETER = -1 : _
  1970.           RESUME NEXT
  1971. '
  1972. '     NETBIOS ERROR HANDLING
  1973. '
  1974.        IF ERL => 29900 AND ERL <= 29920 THEN _
  1975.           RESUME NEXT
  1976. '
  1977. '     UPDATEC ERROR HANDLING
  1978. '
  1979.       IF ERL => 43050 AND ERL <= 43060 AND ERR = 61 THEN _
  1980.          A$ = "* Disk full - terminating *" : _
  1981.          SUBROUTINE.PARAMETER =2 : _
  1982.          CALL TPUT : _
  1983.          IF DISKFULL.GO.OFFLINE THEN _
  1984.            GOTO 65010 _
  1985.          ELSE SYSTEM
  1986. '
  1987. '     CHECKINT ERROR HANDLING
  1988. '
  1989.        IF ERL = 59652 AND ERR = 24 THEN _
  1990.           NOT.CTS = TRUE : _
  1991.           CALL LINE25 : _
  1992.           RESUME
  1993.        IF ERL => 52000 AND ERL <= 59660 THEN _           'KG122702
  1994.           RESUME NEXT
  1995. '
  1996. '      VIEW ARC TXT ERROR HANDLER changed 60151 to 60149
  1997. '
  1998.  IF ERL = 60149 AND ERR = 53 THEN _
  1999.          CALL QTPUT ("ERROR !!! No Such File, EXITING",1):_
  2000.          RESUME NEXT
  2001. IF ERL = 60149 AND ERR = 63 THEN _
  2002.          CALL QTPUT ("ERROR Occured, Please notify SysOp",1):_
  2003.          RESUME NEXT
  2004. '
  2005. '
  2006. '      DLVIEW ARC TXT ERROR HANDLER 
  2007. '
  2008.  IF ERL = 60169 AND ERR = 53 THEN _
  2009.          CALL QTPUT ("ERROR !!! No Such File, EXITING",1):_
  2010.          RESUME NEXT
  2011. '
  2012. '      VUZIP ERROR HANDLER
  2013. '
  2014. 'IF ERL = 60175 THEN _        'Pe 03/26/89
  2015. '         RESUME NEXT         'Pe 03/26/89
  2016. '
  2017. '
  2018. '     CATCH ALL OTHER ERRORS
  2019. '
  2020.        A$ = "RBBS-SUB1 Untrapped Error" + _
  2021.             STR$(ERR) + _
  2022.             " in line" + _
  2023.             STR$(ERL)
  2024.        CALL QTPUT (A$,1)
  2025.        CALL UPDTCALR (A$,2)
  2026.        RESUME NEXT
  2027. '     SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL
  2028. 65010  CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")
  2029.        CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  2030.        IF FOSSIL THEN _
  2031.          CALL FOSEXIT(COMPORT%)
  2032.        SYSTEM
  2033.